| 1 | ;;; vhdl-mode.el --- major mode for editing VHDL code |
| 2 | |
| 3 | ;; Copyright (C) 1992-2012 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.33.6" |
| 17 | "VHDL Mode version number.") |
| 18 | |
| 19 | (defconst vhdl-time-stamp "2005-08-30" |
| 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 | ;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X |
| 76 | ;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally) |
| 77 | |
| 78 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 79 | ;; Installation |
| 80 | |
| 81 | ;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X. |
| 82 | |
| 83 | ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation |
| 84 | ;; or into an arbitrary directory that is added to the load path by the |
| 85 | ;; following line in your Emacs start-up file `.emacs': |
| 86 | |
| 87 | ;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) |
| 88 | |
| 89 | ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same |
| 90 | ;; directory. Otherwise, byte-compile the source file: |
| 91 | ;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET |
| 92 | ;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el |
| 93 | |
| 94 | ;; Add the following lines to the `site-start.el' file in the `site-lisp' |
| 95 | ;; directory of your Emacs installation or to your Emacs start-up file `.emacs' |
| 96 | ;; (not required in Emacs 20.X): |
| 97 | |
| 98 | ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) |
| 99 | ;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)) |
| 100 | |
| 101 | ;; More detailed installation instructions are included in the official |
| 102 | ;; VHDL Mode distribution. |
| 103 | |
| 104 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 105 | ;; Acknowledgements |
| 106 | |
| 107 | ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> |
| 108 | ;; and Steve Grout. |
| 109 | |
| 110 | ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>. |
| 111 | ;; Ideas about alignment from John Wiegley <johnw@gnu.org>. |
| 112 | |
| 113 | ;; Many thanks to all the users who sent me bug reports and enhancement |
| 114 | ;; requests. |
| 115 | ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable |
| 116 | ;; enhancement suggestions and the fruitful discussions. |
| 117 | ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. |
| 118 | ;; Thanks to Ulf Klaperski for the indentation speedup hint. |
| 119 | |
| 120 | ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated |
| 121 | ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for |
| 122 | ;; giving me the opportunity to develop this code. |
| 123 | ;; This work has been funded in part by MICROSWISS, a Microelectronics Program |
| 124 | ;; of the Swiss Government. |
| 125 | |
| 126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 127 | |
| 128 | ;;; Code: |
| 129 | |
| 130 | ;; Emacs 21+ handling |
| 131 | (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) |
| 132 | "Non-nil if GNU Emacs 21, 22, ... is used.") |
| 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 |
| 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 | ;; Cadence Leapfrog: cv -file test.vhd |
| 214 | ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared |
| 215 | ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" |
| 216 | nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" |
| 217 | ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0) |
| 218 | ("\\1/entity" "\\2/\\1" "\\1/configuration" |
| 219 | "\\1/package" "\\1/body" downcase)) |
| 220 | ;; Cadence Affirma NC vhdl: ncvhdl test.vhd |
| 221 | ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier |
| 222 | ;; (PLL_400X_TOP) is not declared [10.3]. |
| 223 | ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" |
| 224 | nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" |
| 225 | ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) |
| 226 | ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" |
| 227 | "\\1/package/pc.db" "\\1/body/pc.db" downcase)) |
| 228 | ;; Ikos Voyager: analyze test.vhd |
| 229 | ;; analyze test.vhd |
| 230 | ;; E L4/C5: this library unit is inaccessible |
| 231 | ("Ikos" "analyze" "-l \\1" "make" "-f \\1" |
| 232 | nil "mkdir \\1" "./" "work/" "Makefile" "ikos" |
| 233 | ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2) |
| 234 | ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) |
| 235 | nil) |
| 236 | ;; ModelSim, Model Technology: vcom test.vhd |
| 237 | ;; ERROR: test.vhd(14): Unknown identifier: positiv |
| 238 | ;; WARNING[2]: test.vhd(85): Possible infinite loop |
| 239 | ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb |
| 240 | ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" |
| 241 | nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" |
| 242 | ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) |
| 243 | ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" |
| 244 | "\\1/_primary.dat" "\\1/body.dat" downcase)) |
| 245 | ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd |
| 246 | ;; test.vhd:34: error message |
| 247 | ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" |
| 248 | nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" |
| 249 | ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) |
| 250 | ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" |
| 251 | "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) |
| 252 | ;; QuickHDL, Mentor Graphics: qvhcom test.vhd |
| 253 | ;; ERROR: test.vhd(24): near "dnd": expecting: END |
| 254 | ;; WARNING[4]: test.vhd(30): A space is required between ... |
| 255 | ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" |
| 256 | nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" |
| 257 | ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) |
| 258 | ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" |
| 259 | "\\1/_primary.dat" "\\1/body.dat" downcase)) |
| 260 | ;; Savant: scram -publish-cc test.vhd |
| 261 | ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for |
| 262 | ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" |
| 263 | nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" |
| 264 | ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) |
| 265 | ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" |
| 266 | "\\1_config.vhdl" "\\1_package.vhdl" |
| 267 | "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) |
| 268 | ;; Simili: vhdlp -work test.vhd |
| 269 | ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix |
| 270 | ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" |
| 271 | nil "mkdir \\1" "./" "work/" "Makefile" "simili" |
| 272 | ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0) |
| 273 | ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" |
| 274 | "\\1/prim.var" "\\1/_body.var" downcase)) |
| 275 | ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd |
| 276 | ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier |
| 277 | ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 278 | nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" |
| 279 | ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0) |
| 280 | nil) |
| 281 | ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd |
| 282 | ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. |
| 283 | ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" |
| 284 | nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" |
| 285 | ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) |
| 286 | ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) |
| 287 | ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd |
| 288 | ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. |
| 289 | ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" |
| 290 | nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" |
| 291 | ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) |
| 292 | ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) |
| 293 | ;; Synplify: |
| 294 | ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 |
| 295 | ("Synplify" "n/a" "n/a" "make" "-f \\1" |
| 296 | nil "mkdir \\1" "./" "work/" "Makefile" "synplify" |
| 297 | ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) |
| 298 | nil) |
| 299 | ;; Vantage: analyze -libfile vsslib.ini -src test.vhd |
| 300 | ;; Compiling "test.vhd" line 1... |
| 301 | ;; **Error: LINE 49 *** No aggregate value is valid in this context. |
| 302 | ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 303 | nil "mkdir \\1" "./" "work/" "Makefile" "vantage" |
| 304 | ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) |
| 305 | ("^ *Compiling \"\\(.+\\)\" " 1) |
| 306 | nil) |
| 307 | ;; VeriBest: vc vhdl test.vhd |
| 308 | ;; (no file name printed out!) |
| 309 | ;; 32: Z <= A and BitA ; |
| 310 | ;; ^^^^ |
| 311 | ;; [Error] Name BITA is unknown |
| 312 | ("VeriBest" "vc" "vhdl" "make" "-f \\1" |
| 313 | nil "mkdir \\1" "./" "work/" "Makefile" "veribest" |
| 314 | ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0) |
| 315 | nil) |
| 316 | ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd |
| 317 | ;; Compiling "test.vhd" line 1... |
| 318 | ;; **Error: LINE 49 *** No aggregate value is valid in this context. |
| 319 | ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 320 | nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" |
| 321 | ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) |
| 322 | ("^ *Compiling \"\\(.+\\)\" " 1) |
| 323 | nil) |
| 324 | ) |
| 325 | "*List of available VHDL compilers and their properties. |
| 326 | Each list entry specifies the following items for a compiler: |
| 327 | Compiler: |
| 328 | Compiler name : name used in option `vhdl-compiler' to choose compiler |
| 329 | Compile command : command used for source file compilation |
| 330 | Compile options : compile options (\"\\1\" inserts library name) |
| 331 | Make command : command used for compilation using a Makefile |
| 332 | Make options : make options (\"\\1\" inserts Makefile name) |
| 333 | Generate Makefile: use built-in function or command to generate a Makefile |
| 334 | \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name) |
| 335 | Library command : command to create library directory \(\"\\1\" inserts |
| 336 | library directory, \"\\2\" inserts library name) |
| 337 | Compile directory: where compilation is run and the Makefile is placed |
| 338 | Library directory: directory of default library |
| 339 | Makefile name : name of Makefile (default is \"Makefile\") |
| 340 | ID string : compiler identification string (see `vhdl-project-alist') |
| 341 | Error message: |
| 342 | Regexp : regular expression to match error messages (*) |
| 343 | File subexp index: index of subexpression that matches the file name |
| 344 | Line subexp index: index of subexpression that matches the line number |
| 345 | Column subexp idx: index of subexpression that matches the column number |
| 346 | File message: |
| 347 | Regexp : regular expression to match a file name message |
| 348 | File subexp index: index of subexpression that matches the file name |
| 349 | Unit-to-file name mapping: mapping of library unit names to names of files |
| 350 | generated by the compiler (used for Makefile generation) |
| 351 | To string : string a name is mapped to (\"\\1\" inserts the unit name, |
| 352 | \"\\2\" inserts the entity name for architectures) |
| 353 | Case adjustment : adjust case of inserted unit names |
| 354 | |
| 355 | \(*) The regular expression must match the error message starting from the |
| 356 | beginning of the line (but not necessarily to the end of the line). |
| 357 | |
| 358 | Compile options allows insertion of the library name (see `vhdl-project-alist') |
| 359 | in order to set the compilers library option (e.g. \"vcom -work my_lib\"). |
| 360 | |
| 361 | For Makefile generation, the built-in function can be used (requires |
| 362 | specification of the unit-to-file name mapping). Alternatively, an |
| 363 | external command can be specified. Work directory allows specification of |
| 364 | an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\", |
| 365 | used for Makefile generation). To use another library name than \"work\", |
| 366 | customize `vhdl-project-alist'. The library command is inserted in Makefiles |
| 367 | to automatically create the library directory if not existent. |
| 368 | |
| 369 | Compile options, compile directory, library directory, and Makefile name are |
| 370 | overwritten by the project settings if a project is defined (see |
| 371 | `vhdl-project-alist'). Directory paths are relative to the source file |
| 372 | directory. |
| 373 | |
| 374 | Some compilers do not include the file name in the error message, but print |
| 375 | out a file name message in advance. In this case, set \"File Subexp Index\" |
| 376 | under \"Error Message\" to 0 and fill out the \"File Message\" entries. |
| 377 | If no file name at all is printed out, set both \"File Message\" entries to 0 |
| 378 | \(a default file name message will be printed out instead, does not work in |
| 379 | XEmacs). |
| 380 | |
| 381 | A compiler is selected for syntax analysis (`\\[vhdl-compile]') by |
| 382 | assigning its name to option `vhdl-compiler'. |
| 383 | |
| 384 | Please send any missing or erroneous compiler properties to the maintainer for |
| 385 | updating. |
| 386 | |
| 387 | NOTE: Activate new error and file message regexps and reflect the new setting |
| 388 | in the choice list of option `vhdl-compiler' by restarting Emacs." |
| 389 | :type '(repeat |
| 390 | (list :tag "Compiler" :indent 2 |
| 391 | (string :tag "Compiler name ") |
| 392 | (string :tag "Compile command ") |
| 393 | (string :tag "Compile options " "-work \\1") |
| 394 | (string :tag "Make command " "make") |
| 395 | (string :tag "Make options " "-f \\1") |
| 396 | (choice :tag "Generate Makefile " |
| 397 | (const :tag "Built-in function" nil) |
| 398 | (string :tag "Command" "vmake \\2 > \\1")) |
| 399 | (string :tag "Library command " "mkdir \\1") |
| 400 | (directory :tag "Compile directory " |
| 401 | :validate vhdl-widget-directory-validate "./") |
| 402 | (directory :tag "Library directory " |
| 403 | :validate vhdl-widget-directory-validate "work/") |
| 404 | (file :tag "Makefile name " "Makefile") |
| 405 | (string :tag "ID string ") |
| 406 | (list :tag "Error message" :indent 4 |
| 407 | (regexp :tag "Regexp ") |
| 408 | (integer :tag "File subexp index") |
| 409 | (integer :tag "Line subexp index") |
| 410 | (integer :tag "Column subexp idx")) |
| 411 | (list :tag "File message" :indent 4 |
| 412 | (regexp :tag "Regexp ") |
| 413 | (integer :tag "File subexp index")) |
| 414 | (choice :tag "Unit-to-file name mapping" |
| 415 | :format "%t: %[Value Menu%] %v\n" |
| 416 | (const :tag "Not defined" nil) |
| 417 | (list :tag "To string" :indent 4 |
| 418 | (string :tag "Entity " "\\1.vhd") |
| 419 | (string :tag "Architecture " "\\2_\\1.vhd") |
| 420 | (string :tag "Configuration " "\\1.vhd") |
| 421 | (string :tag "Package " "\\1.vhd") |
| 422 | (string :tag "Package Body " "\\1_body.vhd") |
| 423 | (choice :tag "Case adjustment " |
| 424 | (const :tag "None" identity) |
| 425 | (const :tag "Upcase" upcase) |
| 426 | (const :tag "Downcase" downcase)))))) |
| 427 | :set (lambda (variable value) |
| 428 | (vhdl-custom-set variable value 'vhdl-update-mode-menu)) |
| 429 | :group 'vhdl-compile) |
| 430 | |
| 431 | (defcustom vhdl-compiler "ModelSim" |
| 432 | "*Specifies the VHDL compiler to be used for syntax analysis. |
| 433 | Select a compiler name from the ones defined in option `vhdl-compiler-alist'." |
| 434 | :type (let ((alist vhdl-compiler-alist) list) |
| 435 | (while alist |
| 436 | (setq list (cons (list 'const (caar alist)) list)) |
| 437 | (setq alist (cdr alist))) |
| 438 | (append '(choice) (nreverse list))) |
| 439 | :group 'vhdl-compile) |
| 440 | |
| 441 | (defcustom vhdl-compile-use-local-error-regexp t |
| 442 | "*Non-nil means use buffer-local `compilation-error-regexp-alist'. |
| 443 | In this case, only error message regexps for VHDL compilers are active if |
| 444 | compilation is started from a VHDL buffer. Otherwise, the error message |
| 445 | regexps are appended to the predefined global regexps, and all regexps are |
| 446 | active all the time. Note that by doing that, the predefined global regexps |
| 447 | might result in erroneous parsing of error messages for some VHDL compilers. |
| 448 | |
| 449 | NOTE: Activate the new setting by restarting Emacs." |
| 450 | :type 'boolean |
| 451 | :group 'vhdl-compile) |
| 452 | |
| 453 | (defcustom vhdl-makefile-generation-hook nil |
| 454 | "*Functions to run at the end of Makefile generation. |
| 455 | Allows to insert user specific parts into a Makefile. |
| 456 | |
| 457 | Example: |
| 458 | \(lambda nil |
| 459 | \(re-search-backward \"^# Rule for compiling entire design\") |
| 460 | \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))" |
| 461 | :type 'hook |
| 462 | :group 'vhdl-compile) |
| 463 | |
| 464 | (defcustom vhdl-default-library "work" |
| 465 | "*Name of default library. |
| 466 | Is overwritten by project settings if a project is active." |
| 467 | :type 'string |
| 468 | :group 'vhdl-compile) |
| 469 | |
| 470 | |
| 471 | (defgroup vhdl-project nil |
| 472 | "Customizations for projects." |
| 473 | :group 'vhdl) |
| 474 | |
| 475 | (defcustom vhdl-project-alist |
| 476 | '(("Example 1" "Source files in two directories, custom library name, VHDL'87" |
| 477 | "~/example1/" ("src/system/" "src/components/") "" |
| 478 | (("ModelSim" "-87 \\2" "-f \\1 top_level" nil) |
| 479 | ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) |
| 480 | "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "") |
| 481 | ("Example 2" "Individual source files, multiple compilers in different directories" |
| 482 | "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") "" |
| 483 | nil "\\1/" "work" "\\1/work/" "Makefile" "") |
| 484 | ("Example 3" "Source files in a directory tree, multiple compilers in same directory" |
| 485 | "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/" |
| 486 | nil "./" "work" "work-\\1/" "Makefile-\\1" "\ |
| 487 | ------------------------------------------------------------------------------- |
| 488 | -- This is a multi-line project description |
| 489 | -- that can be used as a project dependent part of the file header. |
| 490 | ")) |
| 491 | "*List of projects and their properties. |
| 492 | Name : name used in option `vhdl-project' to choose project |
| 493 | Title : title of project (single-line string) |
| 494 | Default directory: default project directory (absolute path) |
| 495 | Sources : a) source files : path + \"/\" + file name |
| 496 | b) directory : path + \"/\" |
| 497 | c) directory tree: \"-r \" + path + \"/\" |
| 498 | Exclude regexp : matches file/directory names to be excluded as sources |
| 499 | Compile options : project-specific options for each compiler |
| 500 | Compiler name : name of compiler for which these options are valid |
| 501 | Compile options: project-specific compiler options |
| 502 | (\"\\1\" inserts library name, \"\\2\" default options) |
| 503 | Make options: project-specific make options |
| 504 | (\"\\1\" inserts Makefile name, \"\\2\" default options) |
| 505 | Exceptions : file-specific exceptions |
| 506 | File name regexp: matches file names for which exceptions are valid |
| 507 | - Options : file-specific compiler options string |
| 508 | (\"\\1\" inserts library name, \"\\2\" default options, |
| 509 | \"\\3\" project-specific options) |
| 510 | - Do not compile: do not compile this file (in Makefile) |
| 511 | Compile directory: where compilation is run and the Makefile is placed |
| 512 | \(\"\\1\" inserts compiler ID string) |
| 513 | Library name : name of library (default is \"work\") |
| 514 | Library directory: path to library (\"\\1\" inserts compiler ID string) |
| 515 | Makefile name : name of Makefile |
| 516 | (\"\\1\" inserts compiler ID string, \"\\2\" library name) |
| 517 | Description : description of project (multi-line string) |
| 518 | |
| 519 | Project title and description are used to insert into the file header (see |
| 520 | option `vhdl-file-header'). |
| 521 | |
| 522 | The default directory must have an absolute path (use `M-TAB' for completion). |
| 523 | All other paths can be absolute or relative to the default directory. All |
| 524 | paths must end with '/'. |
| 525 | |
| 526 | The design units found in the sources (files and directories) are shown in the |
| 527 | hierarchy browser. Path and file name can contain wildcards `*' and `?' as |
| 528 | well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute. |
| 529 | Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are |
| 530 | specified, the default directory is taken as source directory. Otherwise, |
| 531 | the default directory is only taken as source directory if there is a sources |
| 532 | entry with the empty string or \"./\". Exclude regexp allows to filter out |
| 533 | specific file and directory names from the list of sources (e.g. CVS |
| 534 | directories). |
| 535 | |
| 536 | Files are compiled in the compile directory. Makefiles are also placed into |
| 537 | the compile directory. Library directory specifies which directory the |
| 538 | compiler compiles into (used to generate the Makefile). |
| 539 | |
| 540 | Since different compile/library directories and Makefiles may exist for |
| 541 | different compilers within one project, these paths and names allow the |
| 542 | insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist'). |
| 543 | Compile options, compile directory, library directory, and Makefile name |
| 544 | overwrite the settings of the current compiler. |
| 545 | |
| 546 | File-specific compiler options (highest priority) overwrite project-specific |
| 547 | options which overwrite default options (lowest priority). Lower priority |
| 548 | options can be inserted in higher priority options. This allows to reuse |
| 549 | default options (e.g. \"-file\") in project- or file-specific options (e.g. |
| 550 | \"-93 -file\"). |
| 551 | |
| 552 | NOTE: Reflect the new setting in the choice list of option `vhdl-project' |
| 553 | by restarting Emacs." |
| 554 | :type `(repeat |
| 555 | (list :tag "Project" :indent 2 |
| 556 | (string :tag "Name ") |
| 557 | (string :tag "Title ") |
| 558 | (directory :tag "Default directory" |
| 559 | :validate vhdl-widget-directory-validate |
| 560 | ,(abbreviate-file-name default-directory)) |
| 561 | (repeat :tag "Sources " :indent 4 |
| 562 | (directory :format " %v" "./")) |
| 563 | (regexp :tag "Exclude regexp ") |
| 564 | (repeat |
| 565 | :tag "Compile options " :indent 4 |
| 566 | (list :tag "Compiler" :indent 6 |
| 567 | ,(let ((alist vhdl-compiler-alist) list) |
| 568 | (while alist |
| 569 | (setq list (cons (list 'const (caar alist)) list)) |
| 570 | (setq alist (cdr alist))) |
| 571 | (append '(choice :tag "Compiler name") |
| 572 | (nreverse list))) |
| 573 | (string :tag "Compile options" "\\2") |
| 574 | (string :tag "Make options " "\\2") |
| 575 | (repeat |
| 576 | :tag "Exceptions " :indent 8 |
| 577 | (cons :format "%v" |
| 578 | (regexp :tag "File name regexp ") |
| 579 | (choice :format "%[Value Menu%] %v" |
| 580 | (string :tag "Options" "\\3") |
| 581 | (const :tag "Do not compile" nil)))))) |
| 582 | (directory :tag "Compile directory" |
| 583 | :validate vhdl-widget-directory-validate "./") |
| 584 | (string :tag "Library name " "work") |
| 585 | (directory :tag "Library directory" |
| 586 | :validate vhdl-widget-directory-validate "work/") |
| 587 | (file :tag "Makefile name " "Makefile") |
| 588 | (string :tag "Description: (type `C-j' for newline)" |
| 589 | :format "%t\n%v\n"))) |
| 590 | :set (lambda (variable value) |
| 591 | (vhdl-custom-set variable value |
| 592 | 'vhdl-update-mode-menu |
| 593 | 'vhdl-speedbar-refresh)) |
| 594 | :group 'vhdl-project) |
| 595 | |
| 596 | (defcustom vhdl-project nil |
| 597 | "*Specifies the default for the current project. |
| 598 | Select a project name from the ones defined in option `vhdl-project-alist'. |
| 599 | Is used to determine the project title and description to be inserted in file |
| 600 | headers and the source files/directories to be scanned in the hierarchy |
| 601 | browser. The current project can also be changed temporarily in the menu." |
| 602 | :type (let ((alist vhdl-project-alist) list) |
| 603 | (while alist |
| 604 | (setq list (cons (list 'const (caar alist)) list)) |
| 605 | (setq alist (cdr alist))) |
| 606 | (append '(choice (const :tag "None" nil) (const :tag "--")) |
| 607 | (nreverse list))) |
| 608 | :group 'vhdl-project) |
| 609 | |
| 610 | (defcustom vhdl-project-file-name '("\\1.prj") |
| 611 | "*List of file names/paths for importing/exporting project setups. |
| 612 | \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is |
| 613 | replaced by the user name (allows to have user-specific project setups). |
| 614 | The first entry is used as file name to import/export individual project |
| 615 | setups. All entries are used to automatically import project setups at |
| 616 | startup (see option `vhdl-project-auto-load'). Projects loaded from the |
| 617 | first entry are automatically made current. Hint: specify local project |
| 618 | setups in first entry, global setups in following entries; loading a local |
| 619 | project setup will make it current, while loading the global setups |
| 620 | is done without changing the current project. |
| 621 | Names can also have an absolute path (i.e. project setups can be stored |
| 622 | in global directories)." |
| 623 | :type '(repeat (string :tag "File name" "\\1.prj")) |
| 624 | :group 'vhdl-project) |
| 625 | |
| 626 | (defcustom vhdl-project-auto-load '(startup) |
| 627 | "*Automatically load project setups from files. |
| 628 | All project setup files that match the file names specified in option |
| 629 | `vhdl-project-file-name' are automatically loaded. The project of the |
| 630 | \(alphabetically) last loaded setup of the first `vhdl-project-file-name' |
| 631 | entry is activated. |
| 632 | A project setup file can be obtained by exporting a project (see menu). |
| 633 | At startup: project setup file is loaded at Emacs startup" |
| 634 | :type '(set (const :tag "At startup" startup)) |
| 635 | :group 'vhdl-project) |
| 636 | |
| 637 | (defcustom vhdl-project-sort t |
| 638 | "*Non-nil means projects are displayed in alphabetical order." |
| 639 | :type 'boolean |
| 640 | :group 'vhdl-project) |
| 641 | |
| 642 | |
| 643 | (defgroup vhdl-style nil |
| 644 | "Customizations for coding styles." |
| 645 | :group 'vhdl |
| 646 | :group 'vhdl-template |
| 647 | :group 'vhdl-port |
| 648 | :group 'vhdl-compose) |
| 649 | |
| 650 | (defcustom vhdl-standard '(87 nil) |
| 651 | "*VHDL standards used. |
| 652 | Basic standard: |
| 653 | VHDL'87 : IEEE Std 1076-1987 |
| 654 | VHDL'93 : IEEE Std 1076-1993 |
| 655 | Additional standards: |
| 656 | VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal) |
| 657 | Math packages: IEEE Std 1076.2 (`math_real', `math_complex') |
| 658 | |
| 659 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 660 | \"Activate Options\"." |
| 661 | :type '(list (choice :tag "Basic standard" |
| 662 | (const :tag "VHDL'87" 87) |
| 663 | (const :tag "VHDL'93" 93)) |
| 664 | (set :tag "Additional standards" :indent 2 |
| 665 | (const :tag "VHDL-AMS" ams) |
| 666 | (const :tag "Math packages" math))) |
| 667 | :set (lambda (variable value) |
| 668 | (vhdl-custom-set variable value |
| 669 | 'vhdl-template-map-init |
| 670 | 'vhdl-mode-abbrev-table-init |
| 671 | 'vhdl-template-construct-alist-init |
| 672 | 'vhdl-template-package-alist-init |
| 673 | 'vhdl-update-mode-menu |
| 674 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 675 | :group 'vhdl-style) |
| 676 | |
| 677 | (defcustom vhdl-basic-offset 2 |
| 678 | "*Amount of basic offset used for indentation. |
| 679 | This value is used by + and - symbols in `vhdl-offsets-alist'." |
| 680 | :type 'integer |
| 681 | :group 'vhdl-style) |
| 682 | |
| 683 | (defcustom vhdl-upper-case-keywords nil |
| 684 | "*Non-nil means convert keywords to upper case. |
| 685 | This is done when typed or expanded or by the fix case functions." |
| 686 | :type 'boolean |
| 687 | :set (lambda (variable value) |
| 688 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 689 | :group 'vhdl-style) |
| 690 | |
| 691 | (defcustom vhdl-upper-case-types nil |
| 692 | "*Non-nil means convert standardized types to upper case. |
| 693 | This is done when expanded or by the fix case functions." |
| 694 | :type 'boolean |
| 695 | :set (lambda (variable value) |
| 696 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 697 | :group 'vhdl-style) |
| 698 | |
| 699 | (defcustom vhdl-upper-case-attributes nil |
| 700 | "*Non-nil means convert standardized attributes to upper case. |
| 701 | This is done when expanded or by the fix case functions." |
| 702 | :type 'boolean |
| 703 | :set (lambda (variable value) |
| 704 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 705 | :group 'vhdl-style) |
| 706 | |
| 707 | (defcustom vhdl-upper-case-enum-values nil |
| 708 | "*Non-nil means convert standardized enumeration values to upper case. |
| 709 | This is done when expanded or by the fix case functions." |
| 710 | :type 'boolean |
| 711 | :set (lambda (variable value) |
| 712 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 713 | :group 'vhdl-style) |
| 714 | |
| 715 | (defcustom vhdl-upper-case-constants t |
| 716 | "*Non-nil means convert standardized constants to upper case. |
| 717 | This is done when expanded." |
| 718 | :type 'boolean |
| 719 | :set (lambda (variable value) |
| 720 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 721 | :group 'vhdl-style) |
| 722 | |
| 723 | (defcustom vhdl-use-direct-instantiation 'standard |
| 724 | "*Non-nil means use VHDL'93 direct component instantiation. |
| 725 | Never : never |
| 726 | Standard: only in VHDL standards that allow it (VHDL'93 and higher) |
| 727 | Always : always" |
| 728 | :type '(choice (const :tag "Never" never) |
| 729 | (const :tag "Standard" standard) |
| 730 | (const :tag "Always" always)) |
| 731 | :group 'vhdl-style) |
| 732 | |
| 733 | |
| 734 | (defgroup vhdl-naming nil |
| 735 | "Customizations for naming conventions." |
| 736 | :group 'vhdl) |
| 737 | |
| 738 | (defcustom vhdl-entity-file-name '(".*" . "\\&") |
| 739 | (concat |
| 740 | "*Specifies how the entity file name is obtained. |
| 741 | The entity file name can be obtained by modifying the entity name (e.g. |
| 742 | attaching or stripping off a substring). The file extension is automatically |
| 743 | taken from the file name of the current buffer." |
| 744 | vhdl-name-doc-string) |
| 745 | :type '(cons (regexp :tag "From regexp") |
| 746 | (string :tag "To string ")) |
| 747 | :group 'vhdl-naming |
| 748 | :group 'vhdl-compose) |
| 749 | |
| 750 | (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2") |
| 751 | (concat |
| 752 | "*Specifies how the architecture file name is obtained. |
| 753 | The architecture file name can be obtained by modifying the entity |
| 754 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 755 | file extension is automatically taken from the file name of the current |
| 756 | buffer. The string that is matched against the regexp is the concatenation |
| 757 | of the entity and the architecture name separated by a space. This gives |
| 758 | access to both names (see default setting as example)." |
| 759 | vhdl-name-doc-string) |
| 760 | :type '(cons (regexp :tag "From regexp") |
| 761 | (string :tag "To string ")) |
| 762 | :group 'vhdl-naming |
| 763 | :group 'vhdl-compose) |
| 764 | |
| 765 | (defcustom vhdl-configuration-file-name '(".*" . "\\&") |
| 766 | (concat |
| 767 | "*Specifies how the configuration file name is obtained. |
| 768 | The configuration file name can be obtained by modifying the configuration |
| 769 | name (e.g. attaching or stripping off a substring). The file extension is |
| 770 | automatically taken from the file name of the current buffer." |
| 771 | vhdl-name-doc-string) |
| 772 | :type '(cons (regexp :tag "From regexp") |
| 773 | (string :tag "To string ")) |
| 774 | :group 'vhdl-naming |
| 775 | :group 'vhdl-compose) |
| 776 | |
| 777 | (defcustom vhdl-package-file-name '(".*" . "\\&") |
| 778 | (concat |
| 779 | "*Specifies how the package file name is obtained. |
| 780 | The package file name can be obtained by modifying the package name (e.g. |
| 781 | attaching or stripping off a substring). The file extension is automatically |
| 782 | taken from the file name of the current buffer. Package files can be created |
| 783 | in a different directory by prepending a relative or absolute path to the |
| 784 | file name." |
| 785 | vhdl-name-doc-string) |
| 786 | :type '(cons (regexp :tag "From regexp") |
| 787 | (string :tag "To string ")) |
| 788 | :group 'vhdl-naming |
| 789 | :group 'vhdl-compose) |
| 790 | |
| 791 | (defcustom vhdl-file-name-case 'identity |
| 792 | "*Specifies how to change case for obtaining file names. |
| 793 | When deriving a file name from a VHDL unit name, case can be changed as |
| 794 | follows: |
| 795 | As Is: case is not changed (taken as is) |
| 796 | Lower Case: whole name is changed to lower case |
| 797 | Upper Case: whole name is changed to upper case |
| 798 | Capitalize: first letter of each word in name is capitalized" |
| 799 | :type '(choice (const :tag "As Is" identity) |
| 800 | (const :tag "Lower Case" downcase) |
| 801 | (const :tag "Upper Case" upcase) |
| 802 | (const :tag "Capitalize" capitalize)) |
| 803 | :group 'vhdl-naming |
| 804 | :group 'vhdl-compose) |
| 805 | |
| 806 | |
| 807 | (defgroup vhdl-template nil |
| 808 | "Customizations for electrification." |
| 809 | :group 'vhdl) |
| 810 | |
| 811 | (defcustom vhdl-electric-keywords '(vhdl user) |
| 812 | "*Type of keywords for which electrification is enabled. |
| 813 | VHDL keywords: invoke built-in templates |
| 814 | User keywords: invoke user models (see option `vhdl-model-alist')" |
| 815 | :type '(set (const :tag "VHDL keywords" vhdl) |
| 816 | (const :tag "User model keywords" user)) |
| 817 | :set (lambda (variable value) |
| 818 | (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) |
| 819 | :group 'vhdl-template) |
| 820 | |
| 821 | (defcustom vhdl-optional-labels 'process |
| 822 | "*Constructs for which labels are to be queried. |
| 823 | Template generators prompt for optional labels for: |
| 824 | None : no constructs |
| 825 | Processes only: processes only (also procedurals in VHDL-AMS) |
| 826 | All constructs: all constructs with optional labels and keyword END" |
| 827 | :type '(choice (const :tag "None" none) |
| 828 | (const :tag "Processes only" process) |
| 829 | (const :tag "All constructs" all)) |
| 830 | :group 'vhdl-template) |
| 831 | |
| 832 | (defcustom vhdl-insert-empty-lines 'unit |
| 833 | "*Specifies whether to insert empty lines in some templates. |
| 834 | This improves readability of code. Empty lines are inserted in: |
| 835 | None : no constructs |
| 836 | Design units only: entities, architectures, configurations, packages only |
| 837 | All constructs : also all constructs with BEGIN...END parts |
| 838 | |
| 839 | Replaces option `vhdl-additional-empty-lines'." |
| 840 | :type '(choice (const :tag "None" none) |
| 841 | (const :tag "Design units only" unit) |
| 842 | (const :tag "All constructs" all)) |
| 843 | :group 'vhdl-template |
| 844 | :group 'vhdl-port |
| 845 | :group 'vhdl-compose) |
| 846 | |
| 847 | (defcustom vhdl-argument-list-indent nil |
| 848 | "*Non-nil means indent argument lists relative to opening parenthesis. |
| 849 | That is, argument, association, and port lists start on the same line as the |
| 850 | opening parenthesis and subsequent lines are indented accordingly. |
| 851 | Otherwise, lists start on a new line and are indented as normal code." |
| 852 | :type 'boolean |
| 853 | :group 'vhdl-template |
| 854 | :group 'vhdl-port |
| 855 | :group 'vhdl-compose) |
| 856 | |
| 857 | (defcustom vhdl-association-list-with-formals t |
| 858 | "*Non-nil means write association lists with formal parameters. |
| 859 | Templates prompt for formal and actual parameters (ports/generics). |
| 860 | When pasting component instantiations, formals are included. |
| 861 | If nil, only a list of actual parameters is entered." |
| 862 | :type 'boolean |
| 863 | :group 'vhdl-template |
| 864 | :group 'vhdl-port |
| 865 | :group 'vhdl-compose) |
| 866 | |
| 867 | (defcustom vhdl-conditions-in-parenthesis nil |
| 868 | "*Non-nil means place parenthesis around condition expressions." |
| 869 | :type 'boolean |
| 870 | :group 'vhdl-template) |
| 871 | |
| 872 | (defcustom vhdl-zero-string "'0'" |
| 873 | "*String to use for a logic zero." |
| 874 | :type 'string |
| 875 | :group 'vhdl-template) |
| 876 | |
| 877 | (defcustom vhdl-one-string "'1'" |
| 878 | "*String to use for a logic one." |
| 879 | :type 'string |
| 880 | :group 'vhdl-template) |
| 881 | |
| 882 | |
| 883 | (defgroup vhdl-header nil |
| 884 | "Customizations for file header." |
| 885 | :group 'vhdl-template |
| 886 | :group 'vhdl-compose) |
| 887 | |
| 888 | (defcustom vhdl-file-header "\ |
| 889 | ------------------------------------------------------------------------------- |
| 890 | -- Title : <title string> |
| 891 | -- Project : <project> |
| 892 | ------------------------------------------------------------------------------- |
| 893 | -- File : <filename> |
| 894 | -- Author : <author> |
| 895 | -- Company : <company> |
| 896 | -- Created : <date> |
| 897 | -- Last update: <date> |
| 898 | -- Platform : <platform> |
| 899 | -- Standard : <standard> |
| 900 | <projectdesc>------------------------------------------------------------------------------- |
| 901 | -- Description: <cursor> |
| 902 | <copyright>------------------------------------------------------------------------------- |
| 903 | -- Revisions : |
| 904 | -- Date Version Author Description |
| 905 | -- <date> 1.0 <login>\tCreated |
| 906 | ------------------------------------------------------------------------------- |
| 907 | |
| 908 | " |
| 909 | "*String or file to insert as file header. |
| 910 | If the string specifies an existing file name, the contents of the file is |
| 911 | inserted, otherwise the string itself is inserted as file header. |
| 912 | Type `C-j' for newlines. |
| 913 | If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> |
| 914 | if the header needs to be version controlled. |
| 915 | |
| 916 | The following keywords for template generation are supported: |
| 917 | <filename> : replaced by the name of the buffer |
| 918 | <author> : replaced by the user name and email address |
| 919 | \(`user-full-name', `mail-host-address', `user-mail-address') |
| 920 | <login> : replaced by user login name (`user-login-name') |
| 921 | <company> : replaced by contents of option `vhdl-company-name' |
| 922 | <date> : replaced by the current date |
| 923 | <year> : replaced by the current year |
| 924 | <project> : replaced by title of current project (`vhdl-project') |
| 925 | <projectdesc> : replaced by description of current project (`vhdl-project') |
| 926 | <copyright> : replaced by copyright string (`vhdl-copyright-string') |
| 927 | <platform> : replaced by contents of option `vhdl-platform-spec' |
| 928 | <standard> : replaced by the VHDL language standard(s) used |
| 929 | <... string> : replaced by a queried string (\"...\" is the prompt word) |
| 930 | <title string>: replaced by file title in automatically generated files |
| 931 | <cursor> : final cursor position |
| 932 | |
| 933 | The (multi-line) project description <projectdesc> can be used as a project |
| 934 | dependent part of the file header and can also contain the above keywords." |
| 935 | :type 'string |
| 936 | :group 'vhdl-header) |
| 937 | |
| 938 | (defcustom vhdl-file-footer "" |
| 939 | "*String or file to insert as file footer. |
| 940 | If the string specifies an existing file name, the contents of the file is |
| 941 | inserted, otherwise the string itself is inserted as file footer (i.e. at |
| 942 | the end of the file). |
| 943 | Type `C-j' for newlines. |
| 944 | The same keywords as in option `vhdl-file-header' can be used." |
| 945 | :type 'string |
| 946 | :group 'vhdl-header) |
| 947 | |
| 948 | (defcustom vhdl-company-name "" |
| 949 | "*Name of company to insert in file header. |
| 950 | See option `vhdl-file-header'." |
| 951 | :type 'string |
| 952 | :group 'vhdl-header) |
| 953 | |
| 954 | (defcustom vhdl-copyright-string "\ |
| 955 | ------------------------------------------------------------------------------- |
| 956 | -- Copyright (c) <year> <company> |
| 957 | " |
| 958 | "*Copyright string to insert in file header. |
| 959 | Can be multi-line string (type `C-j' for newline) and contain other file |
| 960 | header keywords (see option `vhdl-file-header')." |
| 961 | :type 'string |
| 962 | :group 'vhdl-header) |
| 963 | |
| 964 | (defcustom vhdl-platform-spec "" |
| 965 | "*Specification of VHDL platform to insert in file header. |
| 966 | The platform specification should contain names and versions of the |
| 967 | simulation and synthesis tools used. |
| 968 | See option `vhdl-file-header'." |
| 969 | :type 'string |
| 970 | :group 'vhdl-header) |
| 971 | |
| 972 | (defcustom vhdl-date-format "%Y-%m-%d" |
| 973 | "*Specifies the date format to use in the header. |
| 974 | This string is passed as argument to the command `format-time-string'. |
| 975 | For more information on format strings, see the documentation for the |
| 976 | `format-time-string' command (C-h f `format-time-string')." |
| 977 | :type 'string |
| 978 | :group 'vhdl-header) |
| 979 | |
| 980 | (defcustom vhdl-modify-date-prefix-string "-- Last update: " |
| 981 | "*Prefix string of modification date in VHDL file header. |
| 982 | If actualization of the modification date is called (menu, |
| 983 | `\\[vhdl-template-modify]'), this string is searched and the rest |
| 984 | of the line replaced by the current date." |
| 985 | :type 'string |
| 986 | :group 'vhdl-header) |
| 987 | |
| 988 | (defcustom vhdl-modify-date-on-saving t |
| 989 | "*Non-nil means update the modification date when the buffer is saved. |
| 990 | Calls function `\\[vhdl-template-modify]'). |
| 991 | |
| 992 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 993 | \"Activate Options\"." |
| 994 | :type 'boolean |
| 995 | :group 'vhdl-header) |
| 996 | |
| 997 | |
| 998 | (defgroup vhdl-sequential-process nil |
| 999 | "Customizations for sequential processes." |
| 1000 | :group 'vhdl-template) |
| 1001 | |
| 1002 | (defcustom vhdl-reset-kind 'async |
| 1003 | "*Specifies which kind of reset to use in sequential processes." |
| 1004 | :type '(choice (const :tag "None" none) |
| 1005 | (const :tag "Synchronous" sync) |
| 1006 | (const :tag "Asynchronous" async)) |
| 1007 | :group 'vhdl-sequential-process) |
| 1008 | |
| 1009 | (defcustom vhdl-reset-active-high nil |
| 1010 | "*Non-nil means reset in sequential processes is active high. |
| 1011 | Otherwise, reset is active low." |
| 1012 | :type 'boolean |
| 1013 | :group 'vhdl-sequential-process) |
| 1014 | |
| 1015 | (defcustom vhdl-clock-rising-edge t |
| 1016 | "*Non-nil means rising edge of clock triggers sequential processes. |
| 1017 | Otherwise, falling edge triggers." |
| 1018 | :type 'boolean |
| 1019 | :group 'vhdl-sequential-process) |
| 1020 | |
| 1021 | (defcustom vhdl-clock-edge-condition 'standard |
| 1022 | "*Syntax of the clock edge condition. |
| 1023 | Standard: \"clk'event and clk = '1'\" |
| 1024 | Function: \"rising_edge(clk)\"" |
| 1025 | :type '(choice (const :tag "Standard" standard) |
| 1026 | (const :tag "Function" function)) |
| 1027 | :group 'vhdl-sequential-process) |
| 1028 | |
| 1029 | (defcustom vhdl-clock-name "" |
| 1030 | "*Name of clock signal to use in templates." |
| 1031 | :type 'string |
| 1032 | :group 'vhdl-sequential-process) |
| 1033 | |
| 1034 | (defcustom vhdl-reset-name "" |
| 1035 | "*Name of reset signal to use in templates." |
| 1036 | :type 'string |
| 1037 | :group 'vhdl-sequential-process) |
| 1038 | |
| 1039 | |
| 1040 | (defgroup vhdl-model nil |
| 1041 | "Customizations for user models." |
| 1042 | :group 'vhdl) |
| 1043 | |
| 1044 | (defcustom vhdl-model-alist |
| 1045 | '(("Example Model" |
| 1046 | "<label> : process (<clock>, <reset>) |
| 1047 | begin -- process <label> |
| 1048 | if <reset> = '0' then -- asynchronous reset (active low) |
| 1049 | <cursor> |
| 1050 | elsif <clock>'event and <clock> = '1' then -- rising clock edge |
| 1051 | if <enable> = '1' then -- synchronous load |
| 1052 | |
| 1053 | end if; |
| 1054 | end if; |
| 1055 | end process <label>;" |
| 1056 | "e" "")) |
| 1057 | "*List of user models. |
| 1058 | VHDL models (templates) can be specified by the user in this list. They can be |
| 1059 | invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword |
| 1060 | electrification (i.e. overriding existing or creating new keywords, see |
| 1061 | option `vhdl-electric-keywords'). |
| 1062 | Name : name of model (string of words and spaces) |
| 1063 | String : string or name of file to be inserted as model (newline: `C-j') |
| 1064 | Key Binding: key binding to invoke model, added to prefix `C-c C-m' |
| 1065 | (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\") |
| 1066 | Keyword : keyword to invoke model |
| 1067 | |
| 1068 | The models can contain prompts to be queried. A prompt is of the form \"<...>\". |
| 1069 | A prompt that appears several times is queried once and replaced throughout |
| 1070 | the model. Special prompts are: |
| 1071 | <clock> : name specified in `vhdl-clock-name' (if not empty) |
| 1072 | <reset> : name specified in `vhdl-reset-name' (if not empty) |
| 1073 | <cursor>: final cursor position |
| 1074 | File header prompts (see variable `vhdl-file-header') are automatically |
| 1075 | replaced, so that user models can also be used to insert different types of |
| 1076 | headers. |
| 1077 | |
| 1078 | If the string specifies an existing file name, the contents of the file is |
| 1079 | inserted, otherwise the string itself is inserted. |
| 1080 | The code within the models should be correctly indented. |
| 1081 | Type `C-j' for newlines. |
| 1082 | |
| 1083 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1084 | \"Activate Options\"." |
| 1085 | :type '(repeat (list :tag "Model" :indent 2 |
| 1086 | (string :tag "Name ") |
| 1087 | (string :tag "String : (type `C-j' for newline)" |
| 1088 | :format "%t\n%v") |
| 1089 | (sexp :tag "Key binding" x) |
| 1090 | (string :tag "Keyword " :format "%t: %v\n"))) |
| 1091 | :set (lambda (variable value) |
| 1092 | (vhdl-custom-set variable value |
| 1093 | 'vhdl-model-map-init |
| 1094 | 'vhdl-model-defun |
| 1095 | 'vhdl-mode-abbrev-table-init |
| 1096 | 'vhdl-update-mode-menu)) |
| 1097 | :group 'vhdl-model) |
| 1098 | |
| 1099 | |
| 1100 | (defgroup vhdl-compose nil |
| 1101 | "Customizations for structural composition." |
| 1102 | :group 'vhdl) |
| 1103 | |
| 1104 | (defcustom vhdl-compose-architecture-name '(".*" . "str") |
| 1105 | (concat |
| 1106 | "*Specifies how the component architecture name is obtained. |
| 1107 | The component architecture name can be obtained by modifying the entity name |
| 1108 | \(e.g. attaching or stripping off a substring). |
| 1109 | If TO STRING is empty, the architecture name is queried." |
| 1110 | vhdl-name-doc-string) |
| 1111 | :type '(cons (regexp :tag "From regexp") |
| 1112 | (string :tag "To string ")) |
| 1113 | :group 'vhdl-compose) |
| 1114 | |
| 1115 | (defcustom vhdl-compose-configuration-name |
| 1116 | '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg") |
| 1117 | (concat |
| 1118 | "*Specifies how the configuration name is obtained. |
| 1119 | The configuration name can be obtained by modifying the entity and/or |
| 1120 | architecture name (e.g. attaching or stripping off a substring). The string |
| 1121 | that is matched against the regexp is the concatenation of the entity and the |
| 1122 | architecture name separated by a space. This gives access to both names (see |
| 1123 | default setting as example)." |
| 1124 | vhdl-name-doc-string) |
| 1125 | :type '(cons (regexp :tag "From regexp") |
| 1126 | (string :tag "To string ")) |
| 1127 | :group 'vhdl-compose) |
| 1128 | |
| 1129 | (defcustom vhdl-components-package-name |
| 1130 | '((".*" . "\\&_components") . "components") |
| 1131 | (concat |
| 1132 | "*Specifies how the name for the components package is obtained. |
| 1133 | The components package is a package containing all component declarations for |
| 1134 | the current design. Its name can be obtained by modifying the project name |
| 1135 | \(e.g. attaching or stripping off a substring). If no project is defined, the |
| 1136 | DIRECTORY entry is chosen." |
| 1137 | vhdl-name-doc-string) |
| 1138 | :type '(cons (cons :tag "Project" :indent 2 |
| 1139 | (regexp :tag "From regexp") |
| 1140 | (string :tag "To string ")) |
| 1141 | (string :tag "Directory:\n String ")) |
| 1142 | :group 'vhdl-compose) |
| 1143 | |
| 1144 | (defcustom vhdl-use-components-package nil |
| 1145 | "*Non-nil means use a separate components package for component declarations. |
| 1146 | Otherwise, component declarations are inserted and searched for in the |
| 1147 | architecture declarative parts." |
| 1148 | :type 'boolean |
| 1149 | :group 'vhdl-compose) |
| 1150 | |
| 1151 | (defcustom vhdl-compose-include-header t |
| 1152 | "*Non-nil means include a header in automatically generated files." |
| 1153 | :type 'boolean |
| 1154 | :group 'vhdl-compose) |
| 1155 | |
| 1156 | (defcustom vhdl-compose-create-files 'single |
| 1157 | "*Specifies whether new files should be created for the new component. |
| 1158 | The component's entity and architecture are inserted: |
| 1159 | None : in current buffer |
| 1160 | Single file : in new single file |
| 1161 | Separate files: in two separate files |
| 1162 | The file names are obtained from variables `vhdl-entity-file-name' and |
| 1163 | `vhdl-architecture-file-name'." |
| 1164 | :type '(choice (const :tag "None" none) |
| 1165 | (const :tag "Single file" single) |
| 1166 | (const :tag "Separate files" separate)) |
| 1167 | :group 'vhdl-compose) |
| 1168 | |
| 1169 | (defcustom vhdl-compose-configuration-create-file nil |
| 1170 | "*Specifies whether a new file should be created for the configuration. |
| 1171 | If non-nil, a new file is created for the configuration. |
| 1172 | The file name is obtained from variable `vhdl-configuration-file-name'." |
| 1173 | :type 'boolean |
| 1174 | :group 'vhdl-compose) |
| 1175 | |
| 1176 | (defcustom vhdl-compose-configuration-hierarchical t |
| 1177 | "*Specifies whether hierarchical configurations should be created. |
| 1178 | If non-nil, automatically created configurations are hierarchical and include |
| 1179 | the whole hierarchy of subcomponents. Otherwise the configuration only |
| 1180 | includes one level of subcomponents." |
| 1181 | :type 'boolean |
| 1182 | :group 'vhdl-compose) |
| 1183 | |
| 1184 | (defcustom vhdl-compose-configuration-use-subconfiguration t |
| 1185 | "*Specifies whether subconfigurations should be used inside configurations. |
| 1186 | If non-nil, automatically created configurations use configurations in binding |
| 1187 | indications for subcomponents, if such configurations exist. Otherwise, |
| 1188 | entities are used in binding indications for subcomponents." |
| 1189 | :type 'boolean |
| 1190 | :group 'vhdl-compose) |
| 1191 | |
| 1192 | |
| 1193 | (defgroup vhdl-port nil |
| 1194 | "Customizations for port translation functions." |
| 1195 | :group 'vhdl |
| 1196 | :group 'vhdl-compose) |
| 1197 | |
| 1198 | (defcustom vhdl-include-port-comments nil |
| 1199 | "*Non-nil means include port comments when a port is pasted." |
| 1200 | :type 'boolean |
| 1201 | :group 'vhdl-port) |
| 1202 | |
| 1203 | (defcustom vhdl-include-direction-comments nil |
| 1204 | "*Non-nil means include port direction in instantiations as comments." |
| 1205 | :type 'boolean |
| 1206 | :group 'vhdl-port) |
| 1207 | |
| 1208 | (defcustom vhdl-include-type-comments nil |
| 1209 | "*Non-nil means include generic/port type in instantiations as comments." |
| 1210 | :type 'boolean |
| 1211 | :group 'vhdl-port) |
| 1212 | |
| 1213 | (defcustom vhdl-include-group-comments 'never |
| 1214 | "*Specifies whether to include group comments and spacings. |
| 1215 | The comments and empty lines between groups of ports are pasted: |
| 1216 | Never : never |
| 1217 | Declarations: in entity/component/constant/signal declarations only |
| 1218 | Always : also in generic/port maps" |
| 1219 | :type '(choice (const :tag "Never" never) |
| 1220 | (const :tag "Declarations" decl) |
| 1221 | (const :tag "Always" always)) |
| 1222 | :group 'vhdl-port) |
| 1223 | |
| 1224 | (defcustom vhdl-actual-port-name '(".*" . "\\&") |
| 1225 | (concat |
| 1226 | "*Specifies how actual port names are obtained from formal port names. |
| 1227 | In a component instantiation, an actual port name can be obtained by |
| 1228 | modifying the formal port name (e.g. attaching or stripping off a substring)." |
| 1229 | vhdl-name-doc-string) |
| 1230 | :type '(cons (regexp :tag "From regexp") |
| 1231 | (string :tag "To string ")) |
| 1232 | :group 'vhdl-port) |
| 1233 | |
| 1234 | (defcustom vhdl-instance-name '(".*" . "\\&_%d") |
| 1235 | (concat |
| 1236 | "*Specifies how an instance name is obtained. |
| 1237 | The instance name can be obtained by modifying the name of the component to be |
| 1238 | instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced |
| 1239 | by a unique number (starting with 1). |
| 1240 | If TO STRING is empty, the instance name is queried." |
| 1241 | vhdl-name-doc-string) |
| 1242 | :type '(cons (regexp :tag "From regexp") |
| 1243 | (string :tag "To string ")) |
| 1244 | :group 'vhdl-port) |
| 1245 | |
| 1246 | |
| 1247 | (defgroup vhdl-testbench nil |
| 1248 | "Customizations for testbench generation." |
| 1249 | :group 'vhdl-port) |
| 1250 | |
| 1251 | (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb") |
| 1252 | (concat |
| 1253 | "*Specifies how the testbench entity name is obtained. |
| 1254 | The entity name of a testbench can be obtained by modifying the name of |
| 1255 | the component to be tested (e.g. attaching or stripping off a substring)." |
| 1256 | vhdl-name-doc-string) |
| 1257 | :type '(cons (regexp :tag "From regexp") |
| 1258 | (string :tag "To string ")) |
| 1259 | :group 'vhdl-testbench) |
| 1260 | |
| 1261 | (defcustom vhdl-testbench-architecture-name '(".*" . "") |
| 1262 | (concat |
| 1263 | "*Specifies how the testbench architecture name is obtained. |
| 1264 | The testbench architecture name can be obtained by modifying the name of |
| 1265 | the component to be tested (e.g. attaching or stripping off a substring). |
| 1266 | If TO STRING is empty, the architecture name is queried." |
| 1267 | vhdl-name-doc-string) |
| 1268 | :type '(cons (regexp :tag "From regexp") |
| 1269 | (string :tag "To string ")) |
| 1270 | :group 'vhdl-testbench) |
| 1271 | |
| 1272 | (defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name |
| 1273 | (concat |
| 1274 | "*Specifies how the testbench configuration name is obtained. |
| 1275 | The configuration name of a testbench can be obtained by modifying the entity |
| 1276 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 1277 | string that is matched against the regexp is the concatenation of the entity |
| 1278 | and the architecture name separated by a space. This gives access to both |
| 1279 | names (see default setting as example)." |
| 1280 | vhdl-name-doc-string) |
| 1281 | :type '(cons (regexp :tag "From regexp") |
| 1282 | (string :tag "To string ")) |
| 1283 | :group 'vhdl-testbench) |
| 1284 | |
| 1285 | (defcustom vhdl-testbench-dut-name '(".*" . "DUT") |
| 1286 | (concat |
| 1287 | "*Specifies how a DUT instance name is obtained. |
| 1288 | The design-under-test instance name (i.e. the component instantiated in the |
| 1289 | testbench) can be obtained by modifying the component name (e.g. attaching |
| 1290 | or stripping off a substring)." |
| 1291 | vhdl-name-doc-string) |
| 1292 | :type '(cons (regexp :tag "From regexp") |
| 1293 | (string :tag "To string ")) |
| 1294 | :group 'vhdl-testbench) |
| 1295 | |
| 1296 | (defcustom vhdl-testbench-include-header t |
| 1297 | "*Non-nil means include a header in automatically generated files." |
| 1298 | :type 'boolean |
| 1299 | :group 'vhdl-testbench) |
| 1300 | |
| 1301 | (defcustom vhdl-testbench-declarations "\ |
| 1302 | -- clock |
| 1303 | signal Clk : std_logic := '1'; |
| 1304 | " |
| 1305 | "*String or file to be inserted in the testbench declarative part. |
| 1306 | If the string specifies an existing file name, the contents of the file is |
| 1307 | inserted, otherwise the string itself is inserted in the testbench |
| 1308 | architecture before the BEGIN keyword. |
| 1309 | Type `C-j' for newlines." |
| 1310 | :type 'string |
| 1311 | :group 'vhdl-testbench) |
| 1312 | |
| 1313 | (defcustom vhdl-testbench-statements "\ |
| 1314 | -- clock generation |
| 1315 | Clk <= not Clk after 10 ns; |
| 1316 | |
| 1317 | -- waveform generation |
| 1318 | WaveGen_Proc: process |
| 1319 | begin |
| 1320 | -- insert signal assignments here |
| 1321 | |
| 1322 | wait until Clk = '1'; |
| 1323 | end process WaveGen_Proc; |
| 1324 | " |
| 1325 | "*String or file to be inserted in the testbench statement part. |
| 1326 | If the string specifies an existing file name, the contents of the file is |
| 1327 | inserted, otherwise the string itself is inserted in the testbench |
| 1328 | architecture before the END keyword. |
| 1329 | Type `C-j' for newlines." |
| 1330 | :type 'string |
| 1331 | :group 'vhdl-testbench) |
| 1332 | |
| 1333 | (defcustom vhdl-testbench-initialize-signals nil |
| 1334 | "*Non-nil means initialize signals with `0' when declared in testbench." |
| 1335 | :type 'boolean |
| 1336 | :group 'vhdl-testbench) |
| 1337 | |
| 1338 | (defcustom vhdl-testbench-include-library t |
| 1339 | "*Non-nil means a library/use clause for std_logic_1164 is included." |
| 1340 | :type 'boolean |
| 1341 | :group 'vhdl-testbench) |
| 1342 | |
| 1343 | (defcustom vhdl-testbench-include-configuration t |
| 1344 | "*Non-nil means a testbench configuration is attached at the end." |
| 1345 | :type 'boolean |
| 1346 | :group 'vhdl-testbench) |
| 1347 | |
| 1348 | (defcustom vhdl-testbench-create-files 'single |
| 1349 | "*Specifies whether new files should be created for the testbench. |
| 1350 | testbench entity and architecture are inserted: |
| 1351 | None : in current buffer |
| 1352 | Single file : in new single file |
| 1353 | Separate files: in two separate files |
| 1354 | The file names are obtained from variables `vhdl-testbench-entity-file-name' |
| 1355 | and `vhdl-testbench-architecture-file-name'." |
| 1356 | :type '(choice (const :tag "None" none) |
| 1357 | (const :tag "Single file" single) |
| 1358 | (const :tag "Separate files" separate)) |
| 1359 | :group 'vhdl-testbench) |
| 1360 | |
| 1361 | (defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name |
| 1362 | (concat |
| 1363 | "*Specifies how the testbench entity file name is obtained. |
| 1364 | The entity file name can be obtained by modifying the testbench entity name |
| 1365 | \(e.g. attaching or stripping off a substring). The file extension is |
| 1366 | automatically taken from the file name of the current buffer. Testbench |
| 1367 | files can be created in a different directory by prepending a relative or |
| 1368 | absolute path to the file name." |
| 1369 | vhdl-name-doc-string) |
| 1370 | :type '(cons (regexp :tag "From regexp") |
| 1371 | (string :tag "To string ")) |
| 1372 | :group 'vhdl-testbench) |
| 1373 | |
| 1374 | (defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name |
| 1375 | (concat |
| 1376 | "*Specifies how the testbench architecture file name is obtained. |
| 1377 | The architecture file name can be obtained by modifying the testbench entity |
| 1378 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 1379 | string that is matched against the regexp is the concatenation of the entity |
| 1380 | and the architecture name separated by a space. This gives access to both |
| 1381 | names (see default setting as example). Testbench files can be created in |
| 1382 | a different directory by prepending a relative or absolute path to the file |
| 1383 | name." |
| 1384 | vhdl-name-doc-string) |
| 1385 | :type '(cons (regexp :tag "From regexp") |
| 1386 | (string :tag "To string ")) |
| 1387 | :group 'vhdl-testbench) |
| 1388 | |
| 1389 | |
| 1390 | (defgroup vhdl-comment nil |
| 1391 | "Customizations for comments." |
| 1392 | :group 'vhdl) |
| 1393 | |
| 1394 | (defcustom vhdl-self-insert-comments t |
| 1395 | "*Non-nil means various templates automatically insert help comments." |
| 1396 | :type 'boolean |
| 1397 | :group 'vhdl-comment) |
| 1398 | |
| 1399 | (defcustom vhdl-prompt-for-comments t |
| 1400 | "*Non-nil means various templates prompt for user definable comments." |
| 1401 | :type 'boolean |
| 1402 | :group 'vhdl-comment) |
| 1403 | |
| 1404 | (defcustom vhdl-inline-comment-column 40 |
| 1405 | "*Column to indent and align inline comments to. |
| 1406 | Overrides local option `comment-column'. |
| 1407 | |
| 1408 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1409 | \"Activate Options\"." |
| 1410 | :type 'integer |
| 1411 | :group 'vhdl-comment) |
| 1412 | |
| 1413 | (defcustom vhdl-end-comment-column 79 |
| 1414 | "*End of comment column. |
| 1415 | Comments that exceed this column number are wrapped. |
| 1416 | |
| 1417 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1418 | \"Activate Options\"." |
| 1419 | :type 'integer |
| 1420 | :group 'vhdl-comment) |
| 1421 | |
| 1422 | (defvar end-comment-column) |
| 1423 | |
| 1424 | |
| 1425 | (defgroup vhdl-align nil |
| 1426 | "Customizations for alignment." |
| 1427 | :group 'vhdl) |
| 1428 | |
| 1429 | (defcustom vhdl-auto-align t |
| 1430 | "*Non-nil means align some templates automatically after generation." |
| 1431 | :type 'boolean |
| 1432 | :group 'vhdl-align) |
| 1433 | |
| 1434 | (defcustom vhdl-align-groups t |
| 1435 | "*Non-nil means align groups of code lines separately. |
| 1436 | A group of code lines is a region of consecutive lines between two lines that |
| 1437 | match the regexp in option `vhdl-align-group-separate'." |
| 1438 | :type 'boolean |
| 1439 | :group 'vhdl-align) |
| 1440 | |
| 1441 | (defcustom vhdl-align-group-separate "^\\s-*$" |
| 1442 | "*Regexp for matching a line that separates groups of lines for alignment. |
| 1443 | Examples: |
| 1444 | \"^\\s-*$\": matches an empty line |
| 1445 | \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" |
| 1446 | :type 'regexp |
| 1447 | :group 'vhdl-align) |
| 1448 | |
| 1449 | (defcustom vhdl-align-same-indent t |
| 1450 | "*Non-nil means align blocks with same indent separately. |
| 1451 | When a region or the entire buffer is aligned, the code is divided into |
| 1452 | blocks of same indent which are aligned separately (except for argument/port |
| 1453 | lists). This gives nicer alignment in most cases. |
| 1454 | Option `vhdl-align-groups' still applies within these blocks." |
| 1455 | :type 'boolean |
| 1456 | :group 'vhdl-align) |
| 1457 | |
| 1458 | |
| 1459 | (defgroup vhdl-highlight nil |
| 1460 | "Customizations for highlighting." |
| 1461 | :group 'vhdl) |
| 1462 | |
| 1463 | (defcustom vhdl-highlight-keywords t |
| 1464 | "*Non-nil means highlight VHDL keywords and other standardized words. |
| 1465 | The following faces are used: |
| 1466 | `font-lock-keyword-face' : keywords |
| 1467 | `font-lock-type-face' : standardized types |
| 1468 | `vhdl-font-lock-attribute-face': standardized attributes |
| 1469 | `vhdl-font-lock-enumvalue-face': standardized enumeration values |
| 1470 | `vhdl-font-lock-function-face' : standardized function and package names |
| 1471 | |
| 1472 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1473 | entry \"Fontify Buffer\")." |
| 1474 | :type 'boolean |
| 1475 | :set (lambda (variable value) |
| 1476 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1477 | :group 'vhdl-highlight) |
| 1478 | |
| 1479 | (defcustom vhdl-highlight-names t |
| 1480 | "*Non-nil means highlight declaration names and construct labels. |
| 1481 | The following faces are used: |
| 1482 | `font-lock-function-name-face' : names in declarations of units, |
| 1483 | subprograms, components, as well as labels of VHDL constructs |
| 1484 | `font-lock-type-face' : names in type/nature declarations |
| 1485 | `vhdl-font-lock-attribute-face': names in attribute declarations |
| 1486 | `font-lock-variable-name-face' : names in declarations of signals, |
| 1487 | variables, constants, subprogram parameters, generics, and ports |
| 1488 | |
| 1489 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1490 | entry \"Fontify Buffer\")." |
| 1491 | :type 'boolean |
| 1492 | :set (lambda (variable value) |
| 1493 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1494 | :group 'vhdl-highlight) |
| 1495 | |
| 1496 | (defcustom vhdl-highlight-special-words nil |
| 1497 | "*Non-nil means highlight words with special syntax. |
| 1498 | The words with syntax and color specified in option `vhdl-special-syntax-alist' |
| 1499 | are highlighted accordingly. |
| 1500 | Can be used for visual support of naming conventions. |
| 1501 | |
| 1502 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1503 | entry \"Fontify Buffer\")." |
| 1504 | :type 'boolean |
| 1505 | :set (lambda (variable value) |
| 1506 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1507 | :group 'vhdl-highlight) |
| 1508 | |
| 1509 | (defcustom vhdl-highlight-forbidden-words nil |
| 1510 | "*Non-nil means highlight forbidden words. |
| 1511 | The reserved words specified in option `vhdl-forbidden-words' or having the |
| 1512 | syntax specified in option `vhdl-forbidden-syntax' are highlighted in a |
| 1513 | warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to |
| 1514 | use them. |
| 1515 | |
| 1516 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1517 | entry \"Fontify Buffer\")." |
| 1518 | :type 'boolean |
| 1519 | :set (lambda (variable value) |
| 1520 | (vhdl-custom-set variable value |
| 1521 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1522 | :group 'vhdl-highlight) |
| 1523 | |
| 1524 | (defcustom vhdl-highlight-verilog-keywords nil |
| 1525 | "*Non-nil means highlight Verilog keywords as reserved words. |
| 1526 | Verilog keywords are highlighted in a warning color (face |
| 1527 | `vhdl-font-lock-reserved-words-face') to indicate not to use them. |
| 1528 | |
| 1529 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1530 | entry \"Fontify Buffer\")." |
| 1531 | :type 'boolean |
| 1532 | :set (lambda (variable value) |
| 1533 | (vhdl-custom-set variable value |
| 1534 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1535 | :group 'vhdl-highlight) |
| 1536 | |
| 1537 | (defcustom vhdl-highlight-translate-off nil |
| 1538 | "*Non-nil means background-highlight code excluded from translation. |
| 1539 | That is, all code between \"-- pragma translate_off\" and |
| 1540 | \"-- pragma translate_on\" is highlighted using a different background color |
| 1541 | \(face `vhdl-font-lock-translate-off-face'). |
| 1542 | Note: this might slow down on-the-fly fontification (and thus editing). |
| 1543 | |
| 1544 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1545 | entry \"Fontify Buffer\")." |
| 1546 | :type 'boolean |
| 1547 | :set (lambda (variable value) |
| 1548 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1549 | :group 'vhdl-highlight) |
| 1550 | |
| 1551 | (defcustom vhdl-highlight-case-sensitive nil |
| 1552 | "*Non-nil means consider case for highlighting. |
| 1553 | Possible trade-off: |
| 1554 | non-nil also upper-case VHDL words are highlighted, but case of words with |
| 1555 | special syntax is not considered |
| 1556 | nil only lower-case VHDL words are highlighted, but case of words with |
| 1557 | special syntax is considered |
| 1558 | Overrides local option `font-lock-keywords-case-fold-search'. |
| 1559 | |
| 1560 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1561 | entry \"Fontify Buffer\")." |
| 1562 | :type 'boolean |
| 1563 | :group 'vhdl-highlight) |
| 1564 | |
| 1565 | (defcustom vhdl-special-syntax-alist |
| 1566 | '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1") |
| 1567 | ("type" "\\w+_t" "ForestGreen" "PaleGreen") |
| 1568 | ("variable" "\\w+_v" "Grey50" "Grey80")) |
| 1569 | "*List of special syntax to be highlighted. |
| 1570 | If option `vhdl-highlight-special-words' is non-nil, words with the specified |
| 1571 | syntax (as regular expression) are highlighted in the corresponding color. |
| 1572 | |
| 1573 | Name : string of words and spaces |
| 1574 | Regexp : regular expression describing word syntax |
| 1575 | (e.g. \"\\\w+_c\" matches word with suffix \"_c\") |
| 1576 | Color (light): foreground color for light background |
| 1577 | (matching color examples: Gold3, Grey50, LimeGreen, Tomato, |
| 1578 | LightSeaGreen, DodgerBlue, Gold, PaleVioletRed) |
| 1579 | Color (dark) : foreground color for dark background |
| 1580 | (matching color examples: BurlyWood1, Grey80, Green, Coral, |
| 1581 | AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1) |
| 1582 | |
| 1583 | Can be used for visual support of naming conventions, such as highlighting |
| 1584 | different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g. |
| 1585 | \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using |
| 1586 | common substrings or name suffices. |
| 1587 | For each entry, a new face is generated with the specified colors and name |
| 1588 | \"vhdl-font-lock-\" + name + \"-face\". |
| 1589 | |
| 1590 | NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu |
| 1591 | entry \"Fontify Buffer\"). All other changes require restarting Emacs." |
| 1592 | :type '(repeat (list :tag "Face" :indent 2 |
| 1593 | (string :tag "Name ") |
| 1594 | (regexp :tag "Regexp " "\\w+_") |
| 1595 | (string :tag "Color (light)") |
| 1596 | (string :tag "Color (dark) "))) |
| 1597 | :set (lambda (variable value) |
| 1598 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1599 | :group 'vhdl-highlight) |
| 1600 | |
| 1601 | (defcustom vhdl-forbidden-words '() |
| 1602 | "*List of forbidden words to be highlighted. |
| 1603 | If option `vhdl-highlight-forbidden-words' is non-nil, these reserved |
| 1604 | words are highlighted in a warning color to indicate not to use them. |
| 1605 | |
| 1606 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1607 | entry \"Fontify Buffer\")." |
| 1608 | :type '(repeat (string :format "%v")) |
| 1609 | :set (lambda (variable value) |
| 1610 | (vhdl-custom-set variable value |
| 1611 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1612 | :group 'vhdl-highlight) |
| 1613 | |
| 1614 | (defcustom vhdl-forbidden-syntax "" |
| 1615 | "*Syntax of forbidden words to be highlighted. |
| 1616 | If option `vhdl-highlight-forbidden-words' is non-nil, words with this |
| 1617 | syntax are highlighted in a warning color to indicate not to use them. |
| 1618 | Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\" |
| 1619 | highlights identifiers with 10 or more characters). |
| 1620 | |
| 1621 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1622 | entry \"Fontify Buffer\")." |
| 1623 | :type 'regexp |
| 1624 | :set (lambda (variable value) |
| 1625 | (vhdl-custom-set variable value |
| 1626 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1627 | :group 'vhdl-highlight) |
| 1628 | |
| 1629 | (defcustom vhdl-directive-keywords '("pragma" "synopsys") |
| 1630 | "*List of compiler directive keywords recognized for highlighting. |
| 1631 | |
| 1632 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1633 | entry \"Fontify Buffer\")." |
| 1634 | :type '(repeat (string :format "%v")) |
| 1635 | :set (lambda (variable value) |
| 1636 | (vhdl-custom-set variable value |
| 1637 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1638 | :group 'vhdl-highlight) |
| 1639 | |
| 1640 | |
| 1641 | (defgroup vhdl-speedbar nil |
| 1642 | "Customizations for speedbar." |
| 1643 | :group 'vhdl) |
| 1644 | |
| 1645 | (defcustom vhdl-speedbar-auto-open nil |
| 1646 | "*Non-nil means automatically open speedbar at startup. |
| 1647 | Alternatively, the speedbar can be opened from the VHDL menu." |
| 1648 | :type 'boolean |
| 1649 | :group 'vhdl-speedbar) |
| 1650 | |
| 1651 | (defcustom vhdl-speedbar-display-mode 'files |
| 1652 | "*Specifies the default displaying mode when opening speedbar. |
| 1653 | Alternatively, the displaying mode can be selected from the speedbar menu or |
| 1654 | by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)." |
| 1655 | :type '(choice (const :tag "Files" files) |
| 1656 | (const :tag "Directory hierarchy" directory) |
| 1657 | (const :tag "Project hierarchy" project)) |
| 1658 | :group 'vhdl-speedbar) |
| 1659 | |
| 1660 | (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50)) |
| 1661 | "*Limits scanning of large files and netlists. |
| 1662 | Design units: maximum file size to scan for design units |
| 1663 | Hierarchy (instances of subcomponents): |
| 1664 | File size: maximum file size to scan for instances (in bytes) |
| 1665 | Instances per arch: maximum number of instances to scan per architecture |
| 1666 | |
| 1667 | \"None\" always means that there is no limit. |
| 1668 | In case of files not or incompletely scanned, a warning message and the file |
| 1669 | names are printed out. |
| 1670 | Background: scanning for instances is considerably slower than scanning for |
| 1671 | design units, especially when there are many instances. These limits should |
| 1672 | prevent the scanning of large netlists." |
| 1673 | :type '(list (choice :tag "Design units" |
| 1674 | :format "%t : %[Value Menu%] %v" |
| 1675 | (const :tag "None" nil) |
| 1676 | (integer :tag "File size")) |
| 1677 | (list :tag "Hierarchy" :indent 2 |
| 1678 | (choice :tag "File size" |
| 1679 | :format "%t : %[Value Menu%] %v" |
| 1680 | (const :tag "None" nil) |
| 1681 | (integer :tag "Size ")) |
| 1682 | (choice :tag "Instances per arch" |
| 1683 | (const :tag "None" nil) |
| 1684 | (integer :tag "Number ")))) |
| 1685 | :group 'vhdl-speedbar) |
| 1686 | |
| 1687 | (defcustom vhdl-speedbar-jump-to-unit t |
| 1688 | "*Non-nil means jump to the design unit code when opened in a buffer. |
| 1689 | The buffer cursor position is left unchanged otherwise." |
| 1690 | :type 'boolean |
| 1691 | :group 'vhdl-speedbar) |
| 1692 | |
| 1693 | (defcustom vhdl-speedbar-update-on-saving t |
| 1694 | "*Automatically update design hierarchy when buffer is saved." |
| 1695 | :type 'boolean |
| 1696 | :group 'vhdl-speedbar) |
| 1697 | |
| 1698 | (defcustom vhdl-speedbar-save-cache '(hierarchy display) |
| 1699 | "*Automatically save modified hierarchy caches when exiting Emacs. |
| 1700 | Hierarchy: design hierarchy information |
| 1701 | Display: displaying information (which design units to expand)" |
| 1702 | :type '(set (const :tag "Hierarchy" hierarchy) |
| 1703 | (const :tag "Display" display)) |
| 1704 | :group 'vhdl-speedbar) |
| 1705 | |
| 1706 | (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2" |
| 1707 | "*Name of file for saving hierarchy cache. |
| 1708 | \"\\1\" is replaced by the project name if a project is specified, |
| 1709 | \"directory\" otherwise. \"\\2\" is replaced by the user name (allows for |
| 1710 | different users to have cache files in the same directory). Can also have |
| 1711 | an absolute path (i.e. all caches can be stored in one global directory)." |
| 1712 | :type 'string |
| 1713 | :group 'vhdl-speedbar) |
| 1714 | |
| 1715 | |
| 1716 | (defgroup vhdl-menu nil |
| 1717 | "Customizations for menus." |
| 1718 | :group 'vhdl) |
| 1719 | |
| 1720 | (defcustom vhdl-index-menu nil |
| 1721 | "*Non-nil means add an index menu for a source file when loading. |
| 1722 | Alternatively, the speedbar can be used. Note that the index menu scans a file |
| 1723 | when it is opened, while speedbar only scans the file upon request." |
| 1724 | :type 'boolean |
| 1725 | :group 'vhdl-menu) |
| 1726 | |
| 1727 | (defcustom vhdl-source-file-menu nil |
| 1728 | "*Non-nil means add a menu of all source files in current directory. |
| 1729 | Alternatively, the speedbar can be used." |
| 1730 | :type 'boolean |
| 1731 | :group 'vhdl-menu) |
| 1732 | |
| 1733 | (defcustom vhdl-hideshow-menu nil |
| 1734 | "*Non-nil means add hideshow menu and functionality at startup. |
| 1735 | Hideshow can also be enabled from the VHDL Mode menu. |
| 1736 | Hideshow allows hiding code of various VHDL constructs. |
| 1737 | |
| 1738 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1739 | \"Activate Options\"." |
| 1740 | :type 'boolean |
| 1741 | :group 'vhdl-menu) |
| 1742 | |
| 1743 | (defcustom vhdl-hide-all-init nil |
| 1744 | "*Non-nil means hide all design units initially after a file is loaded." |
| 1745 | :type 'boolean |
| 1746 | :group 'vhdl-menu) |
| 1747 | |
| 1748 | |
| 1749 | (defgroup vhdl-print nil |
| 1750 | "Customizations for printing." |
| 1751 | :group 'vhdl) |
| 1752 | |
| 1753 | (defcustom vhdl-print-two-column t |
| 1754 | "*Non-nil means print code in two columns and landscape format. |
| 1755 | Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print') |
| 1756 | prints VHDL files in a nice two-column landscape style. |
| 1757 | |
| 1758 | NOTE: Activate the new setting by restarting Emacs. |
| 1759 | Overrides `ps-print' settings locally." |
| 1760 | :type 'boolean |
| 1761 | :group 'vhdl-print) |
| 1762 | |
| 1763 | (defcustom vhdl-print-customize-faces t |
| 1764 | "*Non-nil means use an optimized set of faces for PostScript printing. |
| 1765 | |
| 1766 | NOTE: Activate the new setting by restarting Emacs. |
| 1767 | Overrides `ps-print' settings locally." |
| 1768 | :type 'boolean |
| 1769 | :group 'vhdl-print) |
| 1770 | |
| 1771 | |
| 1772 | (defgroup vhdl-misc nil |
| 1773 | "Miscellaneous customizations." |
| 1774 | :group 'vhdl) |
| 1775 | |
| 1776 | (defcustom vhdl-intelligent-tab t |
| 1777 | "*Non-nil means `TAB' does indentation, word completion and tab insertion. |
| 1778 | That is, if preceding character is part of a word then complete word, |
| 1779 | else if not at beginning of line then insert tab, |
| 1780 | else if last command was a `TAB' or `RET' then dedent one step, |
| 1781 | else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab'). |
| 1782 | If nil, TAB always indents current line (i.e. `TAB' is bound to |
| 1783 | `indent-according-to-mode'). |
| 1784 | |
| 1785 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1786 | \"Activate Options\"." |
| 1787 | :type 'boolean |
| 1788 | :group 'vhdl-misc) |
| 1789 | |
| 1790 | (defcustom vhdl-indent-syntax-based t |
| 1791 | "*Non-nil means indent lines of code based on their syntactic context. |
| 1792 | Otherwise, a line is indented like the previous nonblank line. This can be |
| 1793 | useful in large files where syntax-based indentation gets very slow." |
| 1794 | :type 'boolean |
| 1795 | :group 'vhdl-misc) |
| 1796 | |
| 1797 | (defcustom vhdl-word-completion-case-sensitive nil |
| 1798 | "*Non-nil means word completion using `TAB' is case sensitive. |
| 1799 | That is, `TAB' completes words that start with the same letters and case. |
| 1800 | Otherwise, case is ignored." |
| 1801 | :type 'boolean |
| 1802 | :group 'vhdl-misc) |
| 1803 | |
| 1804 | (defcustom vhdl-word-completion-in-minibuffer t |
| 1805 | "*Non-nil enables word completion in minibuffer (for template prompts). |
| 1806 | |
| 1807 | NOTE: Activate the new setting by restarting Emacs." |
| 1808 | :type 'boolean |
| 1809 | :group 'vhdl-misc) |
| 1810 | |
| 1811 | (defcustom vhdl-underscore-is-part-of-word nil |
| 1812 | "*Non-nil means consider the underscore character `_' as part of word. |
| 1813 | An identifier containing underscores is then treated as a single word in |
| 1814 | select and move operations. All parts of an identifier separated by underscore |
| 1815 | are treated as single words otherwise. |
| 1816 | |
| 1817 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1818 | \"Activate Options\"." |
| 1819 | :type 'boolean |
| 1820 | :set (lambda (variable value) |
| 1821 | (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init)) |
| 1822 | :group 'vhdl-misc) |
| 1823 | |
| 1824 | |
| 1825 | (defgroup vhdl-related nil |
| 1826 | "Related general customizations." |
| 1827 | :group 'vhdl) |
| 1828 | |
| 1829 | ;; add related general customizations |
| 1830 | (custom-add-to-group 'vhdl-related 'hideshow 'custom-group) |
| 1831 | (if (featurep 'xemacs) |
| 1832 | (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) |
| 1833 | (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) |
| 1834 | (custom-add-to-group 'vhdl-related 'ps-print 'custom-group) |
| 1835 | (custom-add-to-group 'vhdl-related 'speedbar 'custom-group) |
| 1836 | (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) |
| 1837 | (unless (featurep 'xemacs) |
| 1838 | (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) |
| 1839 | (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) |
| 1840 | (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable) |
| 1841 | (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable) |
| 1842 | |
| 1843 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1844 | ;; Internal variables |
| 1845 | |
| 1846 | (defvar vhdl-menu-max-size 20 |
| 1847 | "*Specifies the maximum size of a menu before splitting it into submenus.") |
| 1848 | |
| 1849 | (defvar vhdl-progress-interval 1 |
| 1850 | "*Interval used to update progress status during long operations. |
| 1851 | If a number, percentage complete gets updated after each interval of |
| 1852 | that many seconds. To inhibit all messages, set this option to nil.") |
| 1853 | |
| 1854 | (defvar vhdl-inhibit-startup-warnings-p nil |
| 1855 | "*If non-nil, inhibits start up compatibility warnings.") |
| 1856 | |
| 1857 | (defvar vhdl-strict-syntax-p nil |
| 1858 | "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. |
| 1859 | If the syntactic symbol for a particular line does not match a symbol |
| 1860 | in the offsets alist, an error is generated, otherwise no error is |
| 1861 | reported and the syntactic symbol is ignored.") |
| 1862 | |
| 1863 | (defvar vhdl-echo-syntactic-information-p nil |
| 1864 | "*If non-nil, syntactic info is echoed when the line is indented.") |
| 1865 | |
| 1866 | (defconst vhdl-offsets-alist-default |
| 1867 | '((string . -1000) |
| 1868 | (cpp-macro . -1000) |
| 1869 | (block-open . 0) |
| 1870 | (block-close . 0) |
| 1871 | (statement . 0) |
| 1872 | (statement-cont . vhdl-lineup-statement-cont) |
| 1873 | (statement-block-intro . +) |
| 1874 | (statement-case-intro . +) |
| 1875 | (case-alternative . +) |
| 1876 | (comment . vhdl-lineup-comment) |
| 1877 | (arglist-intro . +) |
| 1878 | (arglist-cont . 0) |
| 1879 | (arglist-cont-nonempty . vhdl-lineup-arglist) |
| 1880 | (arglist-close . vhdl-lineup-arglist) |
| 1881 | (entity . 0) |
| 1882 | (configuration . 0) |
| 1883 | (package . 0) |
| 1884 | (architecture . 0) |
| 1885 | (package-body . 0) |
| 1886 | ) |
| 1887 | "Default settings for offsets of syntactic elements. |
| 1888 | Do not change this constant! See the variable `vhdl-offsets-alist' for |
| 1889 | more information.") |
| 1890 | |
| 1891 | (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) |
| 1892 | "*Association list of syntactic element symbols and indentation offsets. |
| 1893 | As described below, each cons cell in this list has the form: |
| 1894 | |
| 1895 | (SYNTACTIC-SYMBOL . OFFSET) |
| 1896 | |
| 1897 | When a line is indented, `vhdl-mode' first determines the syntactic |
| 1898 | context of the line by generating a list of symbols called syntactic |
| 1899 | elements. This list can contain more than one syntactic element and |
| 1900 | the global variable `vhdl-syntactic-context' contains the context list |
| 1901 | for the line being indented. Each element in this list is actually a |
| 1902 | cons cell of the syntactic symbol and a buffer position. This buffer |
| 1903 | position is call the relative indent point for the line. Some |
| 1904 | syntactic symbols may not have a relative indent point associated with |
| 1905 | them. |
| 1906 | |
| 1907 | After the syntactic context list for a line is generated, `vhdl-mode' |
| 1908 | calculates the absolute indentation for the line by looking at each |
| 1909 | syntactic element in the list. First, it compares the syntactic |
| 1910 | element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it |
| 1911 | finds a match, it adds the OFFSET to the column of the relative indent |
| 1912 | point. The sum of this calculation for each element in the syntactic |
| 1913 | list is the absolute offset for line being indented. |
| 1914 | |
| 1915 | If the syntactic element does not match any in the `vhdl-offsets-alist', |
| 1916 | an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise |
| 1917 | the element is ignored. |
| 1918 | |
| 1919 | Actually, OFFSET can be an integer, a function, a variable, or one of |
| 1920 | the following symbols: `+', `-', `++', or `--'. These latter |
| 1921 | designate positive or negative multiples of `vhdl-basic-offset', |
| 1922 | respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is |
| 1923 | called with a single argument containing the cons of the syntactic |
| 1924 | element symbol and the relative indent point. The function should |
| 1925 | return an integer offset. |
| 1926 | |
| 1927 | Here is the current list of valid syntactic element symbols: |
| 1928 | |
| 1929 | string -- inside multi-line string |
| 1930 | block-open -- statement block open |
| 1931 | block-close -- statement block close |
| 1932 | statement -- a VHDL statement |
| 1933 | statement-cont -- a continuation of a VHDL statement |
| 1934 | statement-block-intro -- the first line in a new statement block |
| 1935 | statement-case-intro -- the first line in a case alternative block |
| 1936 | case-alternative -- a case statement alternative clause |
| 1937 | comment -- a line containing only a comment |
| 1938 | arglist-intro -- the first line in an argument list |
| 1939 | arglist-cont -- subsequent argument list lines when no |
| 1940 | arguments follow on the same line as |
| 1941 | the arglist opening paren |
| 1942 | arglist-cont-nonempty -- subsequent argument list lines when at |
| 1943 | least one argument follows on the same |
| 1944 | line as the arglist opening paren |
| 1945 | arglist-close -- the solo close paren of an argument list |
| 1946 | entity -- inside an entity declaration |
| 1947 | configuration -- inside a configuration declaration |
| 1948 | package -- inside a package declaration |
| 1949 | architecture -- inside an architecture body |
| 1950 | package-body -- inside a package body") |
| 1951 | |
| 1952 | (defvar vhdl-comment-only-line-offset 0 |
| 1953 | "*Extra offset for line which contains only the start of a comment. |
| 1954 | Can contain an integer or a cons cell of the form: |
| 1955 | |
| 1956 | (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) |
| 1957 | |
| 1958 | Where NON-ANCHORED-OFFSET is the amount of offset given to |
| 1959 | non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is |
| 1960 | the amount of offset to give column-zero anchored comment-only lines. |
| 1961 | Just an integer as value is equivalent to (<val> . 0)") |
| 1962 | |
| 1963 | (defvar vhdl-special-indent-hook nil |
| 1964 | "*Hook for user defined special indentation adjustments. |
| 1965 | This hook gets called after a line is indented by the mode.") |
| 1966 | |
| 1967 | (defvar vhdl-style-alist |
| 1968 | '(("IEEE" |
| 1969 | (vhdl-basic-offset . 4) |
| 1970 | (vhdl-offsets-alist . ()))) |
| 1971 | "Styles of Indentation. |
| 1972 | Elements of this alist are of the form: |
| 1973 | |
| 1974 | (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) |
| 1975 | |
| 1976 | where STYLE-STRING is a short descriptive string used to select a |
| 1977 | style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended |
| 1978 | value for that variable when using the selected style. |
| 1979 | |
| 1980 | There is one special case when VARIABLE is `vhdl-offsets-alist'. In this |
| 1981 | case, the VALUE is a list containing elements of the form: |
| 1982 | |
| 1983 | (SYNTACTIC-SYMBOL . VALUE) |
| 1984 | |
| 1985 | as described in `vhdl-offsets-alist'. These are passed directly to |
| 1986 | `vhdl-set-offset' so there is no need to set every syntactic symbol in |
| 1987 | your style, only those that are different from the default.") |
| 1988 | |
| 1989 | ;; dynamically append the default value of most variables |
| 1990 | (or (assoc "Default" vhdl-style-alist) |
| 1991 | (let* ((varlist '(vhdl-inhibit-startup-warnings-p |
| 1992 | vhdl-strict-syntax-p |
| 1993 | vhdl-echo-syntactic-information-p |
| 1994 | vhdl-basic-offset |
| 1995 | vhdl-offsets-alist |
| 1996 | vhdl-comment-only-line-offset)) |
| 1997 | (default (cons "Default" |
| 1998 | (mapcar |
| 1999 | (function |
| 2000 | (lambda (var) |
| 2001 | (cons var (symbol-value var)))) |
| 2002 | varlist)))) |
| 2003 | (setq vhdl-style-alist (cons default vhdl-style-alist)))) |
| 2004 | |
| 2005 | (defvar vhdl-mode-hook nil |
| 2006 | "*Hook called by `vhdl-mode'.") |
| 2007 | |
| 2008 | |
| 2009 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2010 | ;;; Required packages |
| 2011 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2012 | |
| 2013 | ;; mandatory |
| 2014 | (require 'assoc) |
| 2015 | (require 'compile) ; XEmacs |
| 2016 | (require 'easymenu) |
| 2017 | (require 'hippie-exp) |
| 2018 | |
| 2019 | ;; optional (minimize warning messages during compile) |
| 2020 | (eval-when-compile |
| 2021 | (require 'font-lock) |
| 2022 | (require 'ps-print) |
| 2023 | (require 'speedbar)) |
| 2024 | |
| 2025 | |
| 2026 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2027 | ;;; Compatibility |
| 2028 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2029 | |
| 2030 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2031 | ;; XEmacs compatibility |
| 2032 | |
| 2033 | ;; active regions |
| 2034 | (defun vhdl-keep-region-active () |
| 2035 | "Do whatever is necessary to keep the region active in XEmacs. |
| 2036 | Ignore byte-compiler warnings you might see." |
| 2037 | (and (featurep 'xemacs) |
| 2038 | (setq zmacs-region-stays t))) |
| 2039 | |
| 2040 | ;; `wildcard-to-regexp' is included only in XEmacs 21 |
| 2041 | (unless (fboundp 'wildcard-to-regexp) |
| 2042 | (defun wildcard-to-regexp (wildcard) |
| 2043 | "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'." |
| 2044 | (let* ((i (string-match "[*?]" wildcard)) |
| 2045 | (result (substring wildcard 0 i)) |
| 2046 | (len (length wildcard))) |
| 2047 | (when i |
| 2048 | (while (< i len) |
| 2049 | (let ((ch (aref wildcard i))) |
| 2050 | (setq result (concat result |
| 2051 | (cond ((eq ch ?*) "[^\000]*") |
| 2052 | ((eq ch ??) "[^\000]") |
| 2053 | (t (char-to-string ch))))) |
| 2054 | (setq i (1+ i))))) |
| 2055 | (concat "\\`" result "\\'")))) |
| 2056 | |
| 2057 | ;; `regexp-opt' undefined (`xemacs-devel' not installed) |
| 2058 | ;; `regexp-opt' accelerates fontification by 10-20% |
| 2059 | (unless (fboundp 'regexp-opt) |
| 2060 | ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") |
| 2061 | (defun regexp-opt (strings &optional paren) |
| 2062 | (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) |
| 2063 | (concat open (mapconcat 'regexp-quote strings "\\|") close)))) |
| 2064 | |
| 2065 | ;; `match-string-no-properties' undefined (XEmacs, what else?) |
| 2066 | (unless (fboundp 'match-string-no-properties) |
| 2067 | (defalias 'match-string-no-properties 'match-string)) |
| 2068 | |
| 2069 | ;; `subst-char-in-string' undefined (XEmacs) |
| 2070 | (unless (fboundp 'subst-char-in-string) |
| 2071 | (defun subst-char-in-string (fromchar tochar string &optional inplace) |
| 2072 | (let ((i (length string)) |
| 2073 | (newstr (if inplace string (copy-sequence string)))) |
| 2074 | (while (> i 0) |
| 2075 | (setq i (1- i)) |
| 2076 | (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) |
| 2077 | newstr))) |
| 2078 | |
| 2079 | ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) |
| 2080 | (when (and (featurep 'xemacs) (string< itimer-version "1.09") |
| 2081 | (not noninteractive)) |
| 2082 | (load "itimer") |
| 2083 | (when (string< itimer-version "1.09") |
| 2084 | (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") |
| 2085 | (beep) (sit-for 5))) |
| 2086 | |
| 2087 | ;; `file-expand-wildcards' undefined (XEmacs) |
| 2088 | (unless (fboundp 'file-expand-wildcards) |
| 2089 | (defun file-expand-wildcards (pattern &optional full) |
| 2090 | "Taken from Emacs' `files.el'." |
| 2091 | (let* ((nondir (file-name-nondirectory pattern)) |
| 2092 | (dirpart (file-name-directory pattern)) |
| 2093 | (dirs (if (and dirpart (string-match "[[*?]" dirpart)) |
| 2094 | (mapcar 'file-name-as-directory |
| 2095 | (file-expand-wildcards (directory-file-name dirpart))) |
| 2096 | (list dirpart))) |
| 2097 | contents) |
| 2098 | (while dirs |
| 2099 | (when (or (null (car dirs)) ; Possible if DIRPART is not wild. |
| 2100 | (file-directory-p (directory-file-name (car dirs)))) |
| 2101 | (let ((this-dir-contents |
| 2102 | (delq nil |
| 2103 | (mapcar #'(lambda (name) |
| 2104 | (unless (string-match "\\`\\.\\.?\\'" |
| 2105 | (file-name-nondirectory name)) |
| 2106 | name)) |
| 2107 | (directory-files (or (car dirs) ".") full |
| 2108 | (wildcard-to-regexp nondir)))))) |
| 2109 | (setq contents |
| 2110 | (nconc |
| 2111 | (if (and (car dirs) (not full)) |
| 2112 | (mapcar (function (lambda (name) (concat (car dirs) name))) |
| 2113 | this-dir-contents) |
| 2114 | this-dir-contents) |
| 2115 | contents)))) |
| 2116 | (setq dirs (cdr dirs))) |
| 2117 | contents))) |
| 2118 | |
| 2119 | ;; `member-ignore-case' undefined (XEmacs) |
| 2120 | (unless (fboundp 'member-ignore-case) |
| 2121 | (defalias 'member-ignore-case 'member)) |
| 2122 | |
| 2123 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2124 | ;; Compatibility with older VHDL Mode versions |
| 2125 | |
| 2126 | (defvar vhdl-warnings nil |
| 2127 | "Warnings to tell the user during start up.") |
| 2128 | |
| 2129 | (defun vhdl-run-when-idle (secs repeat function) |
| 2130 | "Wait until idle, then run FUNCTION." |
| 2131 | (if (fboundp 'start-itimer) |
| 2132 | (start-itimer "vhdl-mode" function secs repeat t) |
| 2133 | ; (run-with-idle-timer secs repeat function))) |
| 2134 | ;; explicitly activate timer (necessary when Emacs is already idle) |
| 2135 | (aset (run-with-idle-timer secs repeat function) 0 nil))) |
| 2136 | |
| 2137 | (defun vhdl-warning-when-idle (&rest args) |
| 2138 | "Wait until idle, then print out warning STRING and beep." |
| 2139 | (if noninteractive |
| 2140 | (vhdl-warning (apply 'format args) t) |
| 2141 | (unless vhdl-warnings |
| 2142 | (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) |
| 2143 | (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings)))) |
| 2144 | |
| 2145 | (defun vhdl-warning (string &optional nobeep) |
| 2146 | "Print out warning STRING and beep." |
| 2147 | (message "WARNING: %s" string) |
| 2148 | (unless (or nobeep noninteractive) (beep))) |
| 2149 | |
| 2150 | (defun vhdl-print-warnings () |
| 2151 | "Print out messages in variable `vhdl-warnings'." |
| 2152 | (let ((no-warnings (length vhdl-warnings))) |
| 2153 | (setq vhdl-warnings (nreverse vhdl-warnings)) |
| 2154 | (while vhdl-warnings |
| 2155 | (message "WARNING: %s" (car vhdl-warnings)) |
| 2156 | (setq vhdl-warnings (cdr vhdl-warnings))) |
| 2157 | (beep) |
| 2158 | (when (> no-warnings 1) |
| 2159 | (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) |
| 2160 | |
| 2161 | ;; Backward compatibility checks and fixes |
| 2162 | ;; option `vhdl-compiler' changed format |
| 2163 | (unless (stringp vhdl-compiler) |
| 2164 | (setq vhdl-compiler "ModelSim") |
| 2165 | (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) |
| 2166 | |
| 2167 | ;; option `vhdl-standard' changed format |
| 2168 | (unless (listp vhdl-standard) |
| 2169 | (setq vhdl-standard '(87 nil)) |
| 2170 | (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) |
| 2171 | |
| 2172 | ;; option `vhdl-model-alist' changed format |
| 2173 | (when (= (length (car vhdl-model-alist)) 3) |
| 2174 | (let ((old-alist vhdl-model-alist) |
| 2175 | new-alist) |
| 2176 | (while old-alist |
| 2177 | (setq new-alist (cons (append (car old-alist) '("")) new-alist)) |
| 2178 | (setq old-alist (cdr old-alist))) |
| 2179 | (setq vhdl-model-alist (nreverse new-alist))) |
| 2180 | (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) |
| 2181 | |
| 2182 | ;; option `vhdl-project-alist' changed format |
| 2183 | (when (= (length (car vhdl-project-alist)) 3) |
| 2184 | (let ((old-alist vhdl-project-alist) |
| 2185 | new-alist) |
| 2186 | (while old-alist |
| 2187 | (setq new-alist (cons (append (car old-alist) '("")) new-alist)) |
| 2188 | (setq old-alist (cdr old-alist))) |
| 2189 | (setq vhdl-project-alist (nreverse new-alist))) |
| 2190 | (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) |
| 2191 | |
| 2192 | ;; option `vhdl-project-alist' changed format (3.31.1) |
| 2193 | (when (= (length (car vhdl-project-alist)) 4) |
| 2194 | (let ((old-alist vhdl-project-alist) |
| 2195 | new-alist elem) |
| 2196 | (while old-alist |
| 2197 | (setq elem (car old-alist)) |
| 2198 | (setq new-alist |
| 2199 | (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) |
| 2200 | nil "./" "work" "work/" "Makefile" (nth 3 elem)) |
| 2201 | new-alist)) |
| 2202 | (setq old-alist (cdr old-alist))) |
| 2203 | (setq vhdl-project-alist (nreverse new-alist))) |
| 2204 | (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) |
| 2205 | |
| 2206 | ;; option `vhdl-project-alist' changed format (3.31.12) |
| 2207 | (when (= (length (car vhdl-project-alist)) 10) |
| 2208 | (let ((tmp-alist vhdl-project-alist)) |
| 2209 | (while tmp-alist |
| 2210 | (setcdr (nthcdr 3 (car tmp-alist)) |
| 2211 | (cons "" (nthcdr 4 (car tmp-alist)))) |
| 2212 | (setq tmp-alist (cdr tmp-alist)))) |
| 2213 | (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) |
| 2214 | |
| 2215 | ;; option `vhdl-compiler-alist' changed format (3.31.1) |
| 2216 | (when (= (length (car vhdl-compiler-alist)) 7) |
| 2217 | (let ((old-alist vhdl-compiler-alist) |
| 2218 | new-alist elem) |
| 2219 | (while old-alist |
| 2220 | (setq elem (car old-alist)) |
| 2221 | (setq new-alist |
| 2222 | (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" |
| 2223 | (if (equal (nth 3 elem) "") nil (nth 3 elem)) |
| 2224 | (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) |
| 2225 | (nth 5 elem) (nth 6 elem) nil) |
| 2226 | new-alist)) |
| 2227 | (setq old-alist (cdr old-alist))) |
| 2228 | (setq vhdl-compiler-alist (nreverse new-alist))) |
| 2229 | (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) |
| 2230 | |
| 2231 | ;; option `vhdl-compiler-alist' changed format (3.31.10) |
| 2232 | (when (= (length (car vhdl-compiler-alist)) 12) |
| 2233 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2234 | (while tmp-alist |
| 2235 | (setcdr (nthcdr 4 (car tmp-alist)) |
| 2236 | (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) |
| 2237 | (setq tmp-alist (cdr tmp-alist)))) |
| 2238 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2239 | |
| 2240 | ;; option `vhdl-compiler-alist' changed format (3.31.11) |
| 2241 | (when (= (length (car vhdl-compiler-alist)) 13) |
| 2242 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2243 | (while tmp-alist |
| 2244 | (setcdr (nthcdr 3 (car tmp-alist)) |
| 2245 | (cons "" (nthcdr 4 (car tmp-alist)))) |
| 2246 | (setq tmp-alist (cdr tmp-alist)))) |
| 2247 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2248 | |
| 2249 | ;; option `vhdl-compiler-alist' changed format (3.32.7) |
| 2250 | (when (= (length (nth 11 (car vhdl-compiler-alist))) 3) |
| 2251 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2252 | (while tmp-alist |
| 2253 | (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) |
| 2254 | '(0 . nil)) |
| 2255 | (setq tmp-alist (cdr tmp-alist)))) |
| 2256 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2257 | |
| 2258 | ;; option `vhdl-project': empty value changed from "" to nil (3.31.1) |
| 2259 | (when (equal vhdl-project "") |
| 2260 | (setq vhdl-project nil) |
| 2261 | (customize-save-variable 'vhdl-project vhdl-project)) |
| 2262 | |
| 2263 | ;; option `vhdl-project-file-name': changed format (3.31.17 beta) |
| 2264 | (when (stringp vhdl-project-file-name) |
| 2265 | (setq vhdl-project-file-name (list vhdl-project-file-name)) |
| 2266 | (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) |
| 2267 | |
| 2268 | ;; option `speedbar-indentation-width': introduced in speedbar 0.10 |
| 2269 | (if (not (boundp 'speedbar-indentation-width)) |
| 2270 | (defvar speedbar-indentation-width 2) |
| 2271 | ;; set default to 2 if not already customized |
| 2272 | (unless (get 'speedbar-indentation-width 'saved-value) |
| 2273 | (setq speedbar-indentation-width 2))) |
| 2274 | |
| 2275 | |
| 2276 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2277 | ;;; Help functions / inline substitutions / macros |
| 2278 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2279 | |
| 2280 | (defun vhdl-standard-p (standard) |
| 2281 | "Check if STANDARD is specified as used standard." |
| 2282 | (or (eq standard (car vhdl-standard)) |
| 2283 | (memq standard (cadr vhdl-standard)))) |
| 2284 | |
| 2285 | (defun vhdl-project-p (&optional warning) |
| 2286 | "Return non-nil if a project is displayed, i.e. directories or files are |
| 2287 | specified." |
| 2288 | (if (assoc vhdl-project vhdl-project-alist) |
| 2289 | vhdl-project |
| 2290 | (when (and vhdl-project warning) |
| 2291 | (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) |
| 2292 | nil)) |
| 2293 | |
| 2294 | (defun vhdl-resolve-env-variable (string) |
| 2295 | "Resolve environment variables in STRING." |
| 2296 | (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) |
| 2297 | (setq string (concat (match-string 1 string) |
| 2298 | (getenv (match-string 2 string)) |
| 2299 | (match-string 4 string)))) |
| 2300 | string) |
| 2301 | |
| 2302 | (defun vhdl-default-directory () |
| 2303 | "Return the default directory of the current project or the directory of the |
| 2304 | current buffer if no project is defined." |
| 2305 | (if (vhdl-project-p) |
| 2306 | (expand-file-name (vhdl-resolve-env-variable |
| 2307 | (nth 1 (aget vhdl-project-alist vhdl-project)))) |
| 2308 | default-directory)) |
| 2309 | |
| 2310 | (defmacro vhdl-prepare-search-1 (&rest body) |
| 2311 | "Enable case insensitive search and switch to syntax table that includes '_', |
| 2312 | then execute BODY, and finally restore the old environment. Used for |
| 2313 | consistent searching." |
| 2314 | `(let ((case-fold-search t)) ; case insensitive search |
| 2315 | ;; use extended syntax table |
| 2316 | (with-syntax-table vhdl-mode-ext-syntax-table |
| 2317 | ,@body))) |
| 2318 | |
| 2319 | (defmacro vhdl-prepare-search-2 (&rest body) |
| 2320 | "Enable case insensitive search, switch to syntax table that includes '_', |
| 2321 | and remove `intangible' overlays, then execute BODY, and finally restore the |
| 2322 | old environment. Used for consistent searching." |
| 2323 | ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef |
| 2324 | `(let ((case-fold-search t) ; case insensitive search |
| 2325 | (current-syntax-table (syntax-table)) |
| 2326 | overlay-all-list overlay-intangible-list overlay) |
| 2327 | ;; use extended syntax table |
| 2328 | (set-syntax-table vhdl-mode-ext-syntax-table) |
| 2329 | ;; remove `intangible' overlays |
| 2330 | (when (fboundp 'overlay-lists) |
| 2331 | (setq overlay-all-list (overlay-lists)) |
| 2332 | (setq overlay-all-list |
| 2333 | (append (car overlay-all-list) (cdr overlay-all-list))) |
| 2334 | (while overlay-all-list |
| 2335 | (setq overlay (car overlay-all-list)) |
| 2336 | (when (memq 'intangible (overlay-properties overlay)) |
| 2337 | (setq overlay-intangible-list |
| 2338 | (cons overlay overlay-intangible-list)) |
| 2339 | (overlay-put overlay 'intangible nil)) |
| 2340 | (setq overlay-all-list (cdr overlay-all-list)))) |
| 2341 | ;; execute BODY safely |
| 2342 | (unwind-protect |
| 2343 | (progn ,@body) |
| 2344 | ;; restore syntax table |
| 2345 | (set-syntax-table current-syntax-table) |
| 2346 | ;; restore `intangible' overlays |
| 2347 | (when (fboundp 'overlay-lists) |
| 2348 | (while overlay-intangible-list |
| 2349 | (overlay-put (car overlay-intangible-list) 'intangible t) |
| 2350 | (setq overlay-intangible-list |
| 2351 | (cdr overlay-intangible-list))))))) |
| 2352 | |
| 2353 | (defmacro vhdl-visit-file (file-name issue-error &rest body) |
| 2354 | "Visit file FILE-NAME and execute BODY." |
| 2355 | `(if (null ,file-name) |
| 2356 | (progn ,@body) |
| 2357 | (unless (file-directory-p ,file-name) |
| 2358 | (let ((source-buffer (current-buffer)) |
| 2359 | (visiting-buffer (find-buffer-visiting ,file-name)) |
| 2360 | file-opened) |
| 2361 | (when (or (and visiting-buffer (set-buffer visiting-buffer)) |
| 2362 | (condition-case () |
| 2363 | (progn (set-buffer (create-file-buffer ,file-name)) |
| 2364 | (setq file-opened t) |
| 2365 | (vhdl-insert-file-contents ,file-name) |
| 2366 | (modify-syntax-entry ?\- ". 12" (syntax-table)) |
| 2367 | (modify-syntax-entry ?\n ">" (syntax-table)) |
| 2368 | (modify-syntax-entry ?\^M ">" (syntax-table)) |
| 2369 | (modify-syntax-entry ?_ "w" (syntax-table)) |
| 2370 | t) |
| 2371 | (error |
| 2372 | (if ,issue-error |
| 2373 | (progn |
| 2374 | (when file-opened (kill-buffer (current-buffer))) |
| 2375 | (set-buffer source-buffer) |
| 2376 | (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) |
| 2377 | (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) |
| 2378 | nil)))) |
| 2379 | (condition-case info |
| 2380 | (progn ,@body) |
| 2381 | (error |
| 2382 | (if ,issue-error |
| 2383 | (progn |
| 2384 | (when file-opened (kill-buffer (current-buffer))) |
| 2385 | (set-buffer source-buffer) |
| 2386 | (error (cadr info))) |
| 2387 | (vhdl-warning (cadr info)))))) |
| 2388 | (when file-opened (kill-buffer (current-buffer))) |
| 2389 | (set-buffer source-buffer))))) |
| 2390 | |
| 2391 | (defun vhdl-insert-file-contents (filename) |
| 2392 | "Nicked from `insert-file-contents-literally', but allow coding system |
| 2393 | conversion." |
| 2394 | (let ((format-alist nil) |
| 2395 | (after-insert-file-functions nil) |
| 2396 | (jka-compr-compression-info-list nil)) |
| 2397 | (insert-file-contents filename t))) |
| 2398 | |
| 2399 | (defun vhdl-sort-alist (alist) |
| 2400 | "Sort ALIST." |
| 2401 | (sort alist (function (lambda (a b) (string< (car a) (car b)))))) |
| 2402 | |
| 2403 | (defun vhdl-get-subdirs (directory) |
| 2404 | "Recursively get subdirectories of DIRECTORY." |
| 2405 | (let ((dir-list (list (file-name-as-directory directory))) |
| 2406 | file-list) |
| 2407 | (setq file-list (vhdl-directory-files directory t "\\w.*")) |
| 2408 | (while file-list |
| 2409 | (when (file-directory-p (car file-list)) |
| 2410 | (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) |
| 2411 | (setq file-list (cdr file-list))) |
| 2412 | dir-list)) |
| 2413 | |
| 2414 | (defun vhdl-aput (alist-symbol key &optional value) |
| 2415 | "As `aput', but delete key-value pair if VALUE is nil." |
| 2416 | (if value |
| 2417 | (aput alist-symbol key value) |
| 2418 | (adelete alist-symbol key))) |
| 2419 | |
| 2420 | (defun vhdl-delete (elt list) |
| 2421 | "Delete by side effect the first occurrence of ELT as a member of LIST." |
| 2422 | (setq list (cons nil list)) |
| 2423 | (let ((list1 list)) |
| 2424 | (while (and (cdr list1) (not (equal elt (cadr list1)))) |
| 2425 | (setq list1 (cdr list1))) |
| 2426 | (when list |
| 2427 | (setcdr list1 (cddr list1)))) |
| 2428 | (cdr list)) |
| 2429 | |
| 2430 | (defun vhdl-speedbar-refresh (&optional key) |
| 2431 | "Refresh directory or project with name KEY." |
| 2432 | (when (and (boundp 'speedbar-frame) |
| 2433 | (frame-live-p speedbar-frame)) |
| 2434 | (let ((pos (point)) |
| 2435 | (last-frame (selected-frame))) |
| 2436 | (if (null key) |
| 2437 | (speedbar-refresh) |
| 2438 | (select-frame speedbar-frame) |
| 2439 | (when (save-excursion |
| 2440 | (goto-char (point-min)) |
| 2441 | (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) |
| 2442 | (goto-char (match-end 1)) |
| 2443 | (speedbar-do-function-pointer) |
| 2444 | (backward-char 2) |
| 2445 | (speedbar-do-function-pointer) |
| 2446 | (message "Refreshing speedbar...done")) |
| 2447 | (select-frame last-frame))))) |
| 2448 | |
| 2449 | (defun vhdl-show-messages () |
| 2450 | "Get *Messages* buffer to show recent messages." |
| 2451 | (interactive) |
| 2452 | (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) |
| 2453 | |
| 2454 | (defun vhdl-use-direct-instantiation () |
| 2455 | "Return whether direct instantiation is used." |
| 2456 | (or (eq vhdl-use-direct-instantiation 'always) |
| 2457 | (and (eq vhdl-use-direct-instantiation 'standard) |
| 2458 | (not (vhdl-standard-p '87))))) |
| 2459 | |
| 2460 | (defun vhdl-max-marker (marker1 marker2) |
| 2461 | "Return larger marker." |
| 2462 | (if (> marker1 marker2) marker1 marker2)) |
| 2463 | |
| 2464 | (defun vhdl-goto-marker (marker) |
| 2465 | "Goto marker in appropriate buffer." |
| 2466 | (when (markerp marker) |
| 2467 | (set-buffer (marker-buffer marker))) |
| 2468 | (goto-char marker)) |
| 2469 | |
| 2470 | (defun vhdl-menu-split (list title) |
| 2471 | "Split menu LIST into several submenus, if number of |
| 2472 | elements > `vhdl-menu-max-size'." |
| 2473 | (if (> (length list) vhdl-menu-max-size) |
| 2474 | (let ((remain list) |
| 2475 | (result '()) |
| 2476 | (sublist '()) |
| 2477 | (menuno 1) |
| 2478 | (i 0)) |
| 2479 | (while remain |
| 2480 | (setq sublist (cons (car remain) sublist)) |
| 2481 | (setq remain (cdr remain)) |
| 2482 | (setq i (+ i 1)) |
| 2483 | (if (= i vhdl-menu-max-size) |
| 2484 | (progn |
| 2485 | (setq result (cons (cons (format "%s %s" title menuno) |
| 2486 | (nreverse sublist)) result)) |
| 2487 | (setq i 0) |
| 2488 | (setq menuno (+ menuno 1)) |
| 2489 | (setq sublist '())))) |
| 2490 | (and sublist |
| 2491 | (setq result (cons (cons (format "%s %s" title menuno) |
| 2492 | (nreverse sublist)) result))) |
| 2493 | (nreverse result)) |
| 2494 | list)) |
| 2495 | |
| 2496 | |
| 2497 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2498 | ;;; Bindings |
| 2499 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2500 | |
| 2501 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2502 | ;; Key bindings |
| 2503 | |
| 2504 | (defvar vhdl-template-map nil |
| 2505 | "Keymap for VHDL templates.") |
| 2506 | |
| 2507 | (defun vhdl-template-map-init () |
| 2508 | "Initialize `vhdl-template-map'." |
| 2509 | (setq vhdl-template-map (make-sparse-keymap)) |
| 2510 | ;; key bindings for VHDL templates |
| 2511 | (define-key vhdl-template-map "al" 'vhdl-template-alias) |
| 2512 | (define-key vhdl-template-map "ar" 'vhdl-template-architecture) |
| 2513 | (define-key vhdl-template-map "at" 'vhdl-template-assert) |
| 2514 | (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) |
| 2515 | (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) |
| 2516 | (define-key vhdl-template-map "bl" 'vhdl-template-block) |
| 2517 | (define-key vhdl-template-map "ca" 'vhdl-template-case-is) |
| 2518 | (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) |
| 2519 | (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) |
| 2520 | (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) |
| 2521 | (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) |
| 2522 | (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) |
| 2523 | (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) |
| 2524 | (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) |
| 2525 | (define-key vhdl-template-map "co" 'vhdl-template-constant) |
| 2526 | (define-key vhdl-template-map "di" 'vhdl-template-disconnect) |
| 2527 | (define-key vhdl-template-map "el" 'vhdl-template-else) |
| 2528 | (define-key vhdl-template-map "ei" 'vhdl-template-elsif) |
| 2529 | (define-key vhdl-template-map "en" 'vhdl-template-entity) |
| 2530 | (define-key vhdl-template-map "ex" 'vhdl-template-exit) |
| 2531 | (define-key vhdl-template-map "fi" 'vhdl-template-file) |
| 2532 | (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) |
| 2533 | (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) |
| 2534 | (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) |
| 2535 | (define-key vhdl-template-map "fb" 'vhdl-template-function-body) |
| 2536 | (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) |
| 2537 | (define-key vhdl-template-map "ge" 'vhdl-template-generic) |
| 2538 | (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) |
| 2539 | (define-key vhdl-template-map "gt" 'vhdl-template-group-template) |
| 2540 | (define-key vhdl-template-map "\C-h" 'vhdl-template-header) |
| 2541 | (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) |
| 2542 | (define-key vhdl-template-map "it" 'vhdl-template-if-then) |
| 2543 | (define-key vhdl-template-map "li" 'vhdl-template-library) |
| 2544 | (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) |
| 2545 | (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) |
| 2546 | (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) |
| 2547 | (define-key vhdl-template-map "ma" 'vhdl-template-map) |
| 2548 | (define-key vhdl-template-map "ne" 'vhdl-template-next) |
| 2549 | (define-key vhdl-template-map "ot" 'vhdl-template-others) |
| 2550 | (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) |
| 2551 | (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) |
| 2552 | (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) |
| 2553 | (define-key vhdl-template-map "po" 'vhdl-template-port) |
| 2554 | (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) |
| 2555 | (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) |
| 2556 | (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) |
| 2557 | (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) |
| 2558 | (define-key vhdl-template-map "rp" 'vhdl-template-report) |
| 2559 | (define-key vhdl-template-map "rt" 'vhdl-template-return) |
| 2560 | (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) |
| 2561 | (define-key vhdl-template-map "si" 'vhdl-template-signal) |
| 2562 | (define-key vhdl-template-map "su" 'vhdl-template-subtype) |
| 2563 | (define-key vhdl-template-map "ty" 'vhdl-template-type) |
| 2564 | (define-key vhdl-template-map "us" 'vhdl-template-use) |
| 2565 | (define-key vhdl-template-map "va" 'vhdl-template-variable) |
| 2566 | (define-key vhdl-template-map "wa" 'vhdl-template-wait) |
| 2567 | (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) |
| 2568 | (define-key vhdl-template-map "wi" 'vhdl-template-with) |
| 2569 | (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) |
| 2570 | (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) |
| 2571 | (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) |
| 2572 | (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) |
| 2573 | (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) |
| 2574 | (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) |
| 2575 | (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) |
| 2576 | (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) |
| 2577 | (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) |
| 2578 | (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) |
| 2579 | (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) |
| 2580 | (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) |
| 2581 | (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) |
| 2582 | (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) |
| 2583 | (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) |
| 2584 | (when (vhdl-standard-p 'ams) |
| 2585 | (define-key vhdl-template-map "br" 'vhdl-template-break) |
| 2586 | (define-key vhdl-template-map "cu" 'vhdl-template-case-use) |
| 2587 | (define-key vhdl-template-map "iu" 'vhdl-template-if-use) |
| 2588 | (define-key vhdl-template-map "lm" 'vhdl-template-limit) |
| 2589 | (define-key vhdl-template-map "na" 'vhdl-template-nature) |
| 2590 | (define-key vhdl-template-map "pa" 'vhdl-template-procedural) |
| 2591 | (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) |
| 2592 | (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) |
| 2593 | (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) |
| 2594 | (define-key vhdl-template-map "sn" 'vhdl-template-subnature) |
| 2595 | (define-key vhdl-template-map "te" 'vhdl-template-terminal) |
| 2596 | ) |
| 2597 | (when (vhdl-standard-p 'math) |
| 2598 | (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) |
| 2599 | (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) |
| 2600 | )) |
| 2601 | |
| 2602 | ;; initialize template map for VHDL Mode |
| 2603 | (vhdl-template-map-init) |
| 2604 | |
| 2605 | (defun vhdl-function-name (prefix string &optional postfix) |
| 2606 | "Generate a Lisp function name. |
| 2607 | PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in |
| 2608 | STRING are replaced by `-' and substrings are converted to lower case." |
| 2609 | (let ((name prefix)) |
| 2610 | (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) |
| 2611 | (setq name |
| 2612 | (concat name "-" (downcase (substring string 0 (match-end 1))))) |
| 2613 | (setq string (substring string (match-beginning 2)))) |
| 2614 | (when postfix (setq name (concat name "-" postfix))) |
| 2615 | (intern name))) |
| 2616 | |
| 2617 | (defvar vhdl-model-map nil |
| 2618 | "Keymap for VHDL models.") |
| 2619 | |
| 2620 | (defun vhdl-model-map-init () |
| 2621 | "Initialize `vhdl-model-map'." |
| 2622 | (setq vhdl-model-map (make-sparse-keymap)) |
| 2623 | ;; key bindings for VHDL models |
| 2624 | (let ((model-alist vhdl-model-alist) model) |
| 2625 | (while model-alist |
| 2626 | (setq model (car model-alist)) |
| 2627 | (define-key vhdl-model-map (nth 2 model) |
| 2628 | (vhdl-function-name "vhdl-model" (nth 0 model))) |
| 2629 | (setq model-alist (cdr model-alist))))) |
| 2630 | |
| 2631 | ;; initialize user model map for VHDL Mode |
| 2632 | (vhdl-model-map-init) |
| 2633 | |
| 2634 | (defvar vhdl-mode-map nil |
| 2635 | "Keymap for VHDL Mode.") |
| 2636 | |
| 2637 | (defun vhdl-mode-map-init () |
| 2638 | "Initialize `vhdl-mode-map'." |
| 2639 | (setq vhdl-mode-map (make-sparse-keymap)) |
| 2640 | ;; template key bindings |
| 2641 | (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) |
| 2642 | ;; model key bindings |
| 2643 | (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) |
| 2644 | ;; standard key bindings |
| 2645 | (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) |
| 2646 | (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) |
| 2647 | (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) |
| 2648 | (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) |
| 2649 | (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) |
| 2650 | (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) |
| 2651 | (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) |
| 2652 | (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs |
| 2653 | (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) |
| 2654 | (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) |
| 2655 | (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) |
| 2656 | ;; backspace/delete key bindings |
| 2657 | (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify) |
| 2658 | (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable |
| 2659 | (define-key vhdl-mode-map [delete] 'delete-char) |
| 2660 | (define-key vhdl-mode-map [(meta delete)] 'kill-word)) |
| 2661 | ;; mode specific key bindings |
| 2662 | (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) |
| 2663 | (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) |
| 2664 | (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) |
| 2665 | (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) |
| 2666 | (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) |
| 2667 | (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) |
| 2668 | (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) |
| 2669 | (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) |
| 2670 | (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) |
| 2671 | (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) |
| 2672 | (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) |
| 2673 | (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) |
| 2674 | (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) |
| 2675 | (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) |
| 2676 | (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) |
| 2677 | (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) |
| 2678 | (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) |
| 2679 | (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs |
| 2680 | (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) |
| 2681 | (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) |
| 2682 | (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) |
| 2683 | (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) |
| 2684 | (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) |
| 2685 | (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) |
| 2686 | (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) |
| 2687 | (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) |
| 2688 | (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) |
| 2689 | (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) |
| 2690 | (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) |
| 2691 | (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) |
| 2692 | (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) |
| 2693 | (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) |
| 2694 | (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) |
| 2695 | (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) |
| 2696 | (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) |
| 2697 | (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) |
| 2698 | (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) |
| 2699 | (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) |
| 2700 | (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) |
| 2701 | (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) |
| 2702 | (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) |
| 2703 | (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) |
| 2704 | (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) |
| 2705 | (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) |
| 2706 | (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) |
| 2707 | (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) |
| 2708 | (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) |
| 2709 | (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) |
| 2710 | (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) |
| 2711 | (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) |
| 2712 | (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) |
| 2713 | (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) |
| 2714 | (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) |
| 2715 | (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) |
| 2716 | (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) |
| 2717 | (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) |
| 2718 | (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) |
| 2719 | (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) |
| 2720 | (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) |
| 2721 | (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) |
| 2722 | (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) |
| 2723 | (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) |
| 2724 | (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) |
| 2725 | (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) |
| 2726 | (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) |
| 2727 | (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) |
| 2728 | (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) |
| 2729 | (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) |
| 2730 | (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) |
| 2731 | (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) |
| 2732 | (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) |
| 2733 | (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) |
| 2734 | (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) |
| 2735 | (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) |
| 2736 | (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) |
| 2737 | (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) |
| 2738 | (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) |
| 2739 | (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) |
| 2740 | (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) |
| 2741 | (define-key vhdl-mode-map "\M-\t" 'insert-tab) |
| 2742 | ;; insert commands bindings |
| 2743 | (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) |
| 2744 | (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) |
| 2745 | (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) |
| 2746 | (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) |
| 2747 | ;; electric key bindings |
| 2748 | (define-key vhdl-mode-map " " 'vhdl-electric-space) |
| 2749 | (when vhdl-intelligent-tab |
| 2750 | (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) |
| 2751 | (define-key vhdl-mode-map "\r" 'vhdl-electric-return) |
| 2752 | (define-key vhdl-mode-map "-" 'vhdl-electric-dash) |
| 2753 | (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) |
| 2754 | (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) |
| 2755 | (define-key vhdl-mode-map "'" 'vhdl-electric-quote) |
| 2756 | (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) |
| 2757 | (define-key vhdl-mode-map "," 'vhdl-electric-comma) |
| 2758 | (define-key vhdl-mode-map "." 'vhdl-electric-period) |
| 2759 | (when (vhdl-standard-p 'ams) |
| 2760 | (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) |
| 2761 | |
| 2762 | ;; initialize mode map for VHDL Mode |
| 2763 | (vhdl-mode-map-init) |
| 2764 | |
| 2765 | ;; define special minibuffer keymap for enabling word completion in minibuffer |
| 2766 | ;; (useful in template generator prompts) |
| 2767 | (defvar vhdl-minibuffer-local-map |
| 2768 | (let ((map (make-sparse-keymap))) |
| 2769 | (set-keymap-parent map minibuffer-local-map) |
| 2770 | (when vhdl-word-completion-in-minibuffer |
| 2771 | (define-key map "\t" 'vhdl-minibuffer-tab)) |
| 2772 | map) |
| 2773 | "Keymap for minibuffer used in VHDL Mode.") |
| 2774 | |
| 2775 | ;; set up electric character functions to work with |
| 2776 | ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) |
| 2777 | (mapc |
| 2778 | (function |
| 2779 | (lambda (sym) |
| 2780 | (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) |
| 2781 | (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs) |
| 2782 | '(vhdl-electric-space |
| 2783 | vhdl-electric-tab |
| 2784 | vhdl-electric-return |
| 2785 | vhdl-electric-dash |
| 2786 | vhdl-electric-open-bracket |
| 2787 | vhdl-electric-close-bracket |
| 2788 | vhdl-electric-quote |
| 2789 | vhdl-electric-semicolon |
| 2790 | vhdl-electric-comma |
| 2791 | vhdl-electric-period |
| 2792 | vhdl-electric-equal)) |
| 2793 | |
| 2794 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2795 | ;; Syntax table |
| 2796 | |
| 2797 | (defvar vhdl-mode-syntax-table nil |
| 2798 | "Syntax table used in `vhdl-mode' buffers.") |
| 2799 | |
| 2800 | (defvar vhdl-mode-ext-syntax-table nil |
| 2801 | "Syntax table extended by `_' used in `vhdl-mode' buffers.") |
| 2802 | |
| 2803 | (defun vhdl-mode-syntax-table-init () |
| 2804 | "Initialize `vhdl-mode-syntax-table'." |
| 2805 | (setq vhdl-mode-syntax-table (make-syntax-table)) |
| 2806 | ;; define punctuation |
| 2807 | (modify-syntax-entry ?\# "." vhdl-mode-syntax-table) |
| 2808 | (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table) |
| 2809 | (modify-syntax-entry ?\% "." vhdl-mode-syntax-table) |
| 2810 | (modify-syntax-entry ?\& "." vhdl-mode-syntax-table) |
| 2811 | (modify-syntax-entry ?\' "." vhdl-mode-syntax-table) |
| 2812 | (modify-syntax-entry ?\* "." vhdl-mode-syntax-table) |
| 2813 | (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table) |
| 2814 | (modify-syntax-entry ?\. "." vhdl-mode-syntax-table) |
| 2815 | (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table) |
| 2816 | (modify-syntax-entry ?\: "." vhdl-mode-syntax-table) |
| 2817 | (modify-syntax-entry ?\; "." vhdl-mode-syntax-table) |
| 2818 | (modify-syntax-entry ?\< "." vhdl-mode-syntax-table) |
| 2819 | (modify-syntax-entry ?\= "." vhdl-mode-syntax-table) |
| 2820 | (modify-syntax-entry ?\> "." vhdl-mode-syntax-table) |
| 2821 | (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table) |
| 2822 | (modify-syntax-entry ?\| "." vhdl-mode-syntax-table) |
| 2823 | ;; define string |
| 2824 | (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table) |
| 2825 | ;; define underscore |
| 2826 | (when vhdl-underscore-is-part-of-word |
| 2827 | (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table)) |
| 2828 | ;; a single hyphen is punctuation, but a double hyphen starts a comment |
| 2829 | (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table) |
| 2830 | ;; and \n and \^M end a comment |
| 2831 | (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table) |
| 2832 | (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table) |
| 2833 | ;; define parentheses to match |
| 2834 | (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table) |
| 2835 | (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table) |
| 2836 | (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table) |
| 2837 | (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table) |
| 2838 | (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table) |
| 2839 | (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table) |
| 2840 | ;; extended syntax table including '_' (for simpler search regexps) |
| 2841 | (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table)) |
| 2842 | (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table)) |
| 2843 | |
| 2844 | ;; initialize syntax table for VHDL Mode |
| 2845 | (vhdl-mode-syntax-table-init) |
| 2846 | |
| 2847 | (defvar vhdl-syntactic-context nil |
| 2848 | "Buffer local variable containing syntactic analysis list.") |
| 2849 | (make-variable-buffer-local 'vhdl-syntactic-context) |
| 2850 | |
| 2851 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2852 | ;; Abbrev ook bindings |
| 2853 | |
| 2854 | (defvar vhdl-mode-abbrev-table nil |
| 2855 | "Abbrev table to use in `vhdl-mode' buffers.") |
| 2856 | |
| 2857 | (defun vhdl-mode-abbrev-table-init () |
| 2858 | "Initialize `vhdl-mode-abbrev-table'." |
| 2859 | (define-abbrev-table 'vhdl-mode-abbrev-table |
| 2860 | (append |
| 2861 | (when (memq 'vhdl vhdl-electric-keywords) |
| 2862 | ;; VHDL'93 keywords |
| 2863 | (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) |
| 2864 | '( |
| 2865 | ("--" . vhdl-template-display-comment-hook) |
| 2866 | ("abs" . vhdl-template-default-hook) |
| 2867 | ("access" . vhdl-template-default-hook) |
| 2868 | ("after" . vhdl-template-default-hook) |
| 2869 | ("alias" . vhdl-template-alias-hook) |
| 2870 | ("all" . vhdl-template-default-hook) |
| 2871 | ("and" . vhdl-template-default-hook) |
| 2872 | ("arch" . vhdl-template-architecture-hook) |
| 2873 | ("architecture" . vhdl-template-architecture-hook) |
| 2874 | ("array" . vhdl-template-default-hook) |
| 2875 | ("assert" . vhdl-template-assert-hook) |
| 2876 | ("attr" . vhdl-template-attribute-hook) |
| 2877 | ("attribute" . vhdl-template-attribute-hook) |
| 2878 | ("begin" . vhdl-template-default-indent-hook) |
| 2879 | ("block" . vhdl-template-block-hook) |
| 2880 | ("body" . vhdl-template-default-hook) |
| 2881 | ("buffer" . vhdl-template-default-hook) |
| 2882 | ("bus" . vhdl-template-default-hook) |
| 2883 | ("case" . vhdl-template-case-hook) |
| 2884 | ("comp" . vhdl-template-component-hook) |
| 2885 | ("component" . vhdl-template-component-hook) |
| 2886 | ("cond" . vhdl-template-conditional-signal-asst-hook) |
| 2887 | ("conditional" . vhdl-template-conditional-signal-asst-hook) |
| 2888 | ("conf" . vhdl-template-configuration-hook) |
| 2889 | ("configuration" . vhdl-template-configuration-hook) |
| 2890 | ("cons" . vhdl-template-constant-hook) |
| 2891 | ("constant" . vhdl-template-constant-hook) |
| 2892 | ("disconnect" . vhdl-template-disconnect-hook) |
| 2893 | ("downto" . vhdl-template-default-hook) |
| 2894 | ("else" . vhdl-template-else-hook) |
| 2895 | ("elseif" . vhdl-template-elsif-hook) |
| 2896 | ("elsif" . vhdl-template-elsif-hook) |
| 2897 | ("end" . vhdl-template-default-indent-hook) |
| 2898 | ("entity" . vhdl-template-entity-hook) |
| 2899 | ("exit" . vhdl-template-exit-hook) |
| 2900 | ("file" . vhdl-template-file-hook) |
| 2901 | ("for" . vhdl-template-for-hook) |
| 2902 | ("func" . vhdl-template-function-hook) |
| 2903 | ("function" . vhdl-template-function-hook) |
| 2904 | ("generic" . vhdl-template-generic-hook) |
| 2905 | ("group" . vhdl-template-group-hook) |
| 2906 | ("guarded" . vhdl-template-default-hook) |
| 2907 | ("if" . vhdl-template-if-hook) |
| 2908 | ("impure" . vhdl-template-default-hook) |
| 2909 | ("in" . vhdl-template-default-hook) |
| 2910 | ("inertial" . vhdl-template-default-hook) |
| 2911 | ("inout" . vhdl-template-default-hook) |
| 2912 | ("inst" . vhdl-template-instance-hook) |
| 2913 | ("instance" . vhdl-template-instance-hook) |
| 2914 | ("is" . vhdl-template-default-hook) |
| 2915 | ("label" . vhdl-template-default-hook) |
| 2916 | ("library" . vhdl-template-library-hook) |
| 2917 | ("linkage" . vhdl-template-default-hook) |
| 2918 | ("literal" . vhdl-template-default-hook) |
| 2919 | ("loop" . vhdl-template-bare-loop-hook) |
| 2920 | ("map" . vhdl-template-map-hook) |
| 2921 | ("mod" . vhdl-template-default-hook) |
| 2922 | ("nand" . vhdl-template-default-hook) |
| 2923 | ("new" . vhdl-template-default-hook) |
| 2924 | ("next" . vhdl-template-next-hook) |
| 2925 | ("nor" . vhdl-template-default-hook) |
| 2926 | ("not" . vhdl-template-default-hook) |
| 2927 | ("null" . vhdl-template-default-hook) |
| 2928 | ("of" . vhdl-template-default-hook) |
| 2929 | ("on" . vhdl-template-default-hook) |
| 2930 | ("open" . vhdl-template-default-hook) |
| 2931 | ("or" . vhdl-template-default-hook) |
| 2932 | ("others" . vhdl-template-others-hook) |
| 2933 | ("out" . vhdl-template-default-hook) |
| 2934 | ("pack" . vhdl-template-package-hook) |
| 2935 | ("package" . vhdl-template-package-hook) |
| 2936 | ("port" . vhdl-template-port-hook) |
| 2937 | ("postponed" . vhdl-template-default-hook) |
| 2938 | ("procedure" . vhdl-template-procedure-hook) |
| 2939 | ("process" . vhdl-template-process-hook) |
| 2940 | ("pure" . vhdl-template-default-hook) |
| 2941 | ("range" . vhdl-template-default-hook) |
| 2942 | ("record" . vhdl-template-default-hook) |
| 2943 | ("register" . vhdl-template-default-hook) |
| 2944 | ("reject" . vhdl-template-default-hook) |
| 2945 | ("rem" . vhdl-template-default-hook) |
| 2946 | ("report" . vhdl-template-report-hook) |
| 2947 | ("return" . vhdl-template-return-hook) |
| 2948 | ("rol" . vhdl-template-default-hook) |
| 2949 | ("ror" . vhdl-template-default-hook) |
| 2950 | ("select" . vhdl-template-selected-signal-asst-hook) |
| 2951 | ("severity" . vhdl-template-default-hook) |
| 2952 | ("shared" . vhdl-template-default-hook) |
| 2953 | ("sig" . vhdl-template-signal-hook) |
| 2954 | ("signal" . vhdl-template-signal-hook) |
| 2955 | ("sla" . vhdl-template-default-hook) |
| 2956 | ("sll" . vhdl-template-default-hook) |
| 2957 | ("sra" . vhdl-template-default-hook) |
| 2958 | ("srl" . vhdl-template-default-hook) |
| 2959 | ("subtype" . vhdl-template-subtype-hook) |
| 2960 | ("then" . vhdl-template-default-hook) |
| 2961 | ("to" . vhdl-template-default-hook) |
| 2962 | ("transport" . vhdl-template-default-hook) |
| 2963 | ("type" . vhdl-template-type-hook) |
| 2964 | ("unaffected" . vhdl-template-default-hook) |
| 2965 | ("units" . vhdl-template-default-hook) |
| 2966 | ("until" . vhdl-template-default-hook) |
| 2967 | ("use" . vhdl-template-use-hook) |
| 2968 | ("var" . vhdl-template-variable-hook) |
| 2969 | ("variable" . vhdl-template-variable-hook) |
| 2970 | ("wait" . vhdl-template-wait-hook) |
| 2971 | ("when" . vhdl-template-when-hook) |
| 2972 | ("while" . vhdl-template-while-loop-hook) |
| 2973 | ("with" . vhdl-template-with-hook) |
| 2974 | ("xnor" . vhdl-template-default-hook) |
| 2975 | ("xor" . vhdl-template-default-hook) |
| 2976 | ))) |
| 2977 | ;; VHDL-AMS keywords |
| 2978 | (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) |
| 2979 | (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) |
| 2980 | '( |
| 2981 | ("across" . vhdl-template-default-hook) |
| 2982 | ("break" . vhdl-template-break-hook) |
| 2983 | ("limit" . vhdl-template-limit-hook) |
| 2984 | ("nature" . vhdl-template-nature-hook) |
| 2985 | ("noise" . vhdl-template-default-hook) |
| 2986 | ("procedural" . vhdl-template-procedural-hook) |
| 2987 | ("quantity" . vhdl-template-quantity-hook) |
| 2988 | ("reference" . vhdl-template-default-hook) |
| 2989 | ("spectrum" . vhdl-template-default-hook) |
| 2990 | ("subnature" . vhdl-template-subnature-hook) |
| 2991 | ("terminal" . vhdl-template-terminal-hook) |
| 2992 | ("through" . vhdl-template-default-hook) |
| 2993 | ("tolerance" . vhdl-template-default-hook) |
| 2994 | ))) |
| 2995 | ;; user model keywords |
| 2996 | (when (memq 'user vhdl-electric-keywords) |
| 2997 | (let (abbrev-list keyword) |
| 2998 | (dolist (elem vhdl-model-alist) |
| 2999 | (setq keyword (nth 3 elem)) |
| 3000 | (unless (equal keyword "") |
| 3001 | (push (list keyword "" |
| 3002 | (vhdl-function-name |
| 3003 | "vhdl-model" (nth 0 elem) "hook") 0 'system) |
| 3004 | abbrev-list))) |
| 3005 | abbrev-list))))) |
| 3006 | |
| 3007 | ;; initialize abbrev table for VHDL Mode |
| 3008 | (vhdl-mode-abbrev-table-init) |
| 3009 | |
| 3010 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3011 | ;; Template completion lists |
| 3012 | |
| 3013 | (defvar vhdl-template-construct-alist nil |
| 3014 | "List of built-in construct templates.") |
| 3015 | |
| 3016 | (defun vhdl-template-construct-alist-init () |
| 3017 | "Initialize `vhdl-template-construct-alist'." |
| 3018 | (setq |
| 3019 | vhdl-template-construct-alist |
| 3020 | (append |
| 3021 | '( |
| 3022 | ("alias declaration" vhdl-template-alias) |
| 3023 | ("architecture body" vhdl-template-architecture) |
| 3024 | ("assertion" vhdl-template-assert) |
| 3025 | ("attribute declaration" vhdl-template-attribute-decl) |
| 3026 | ("attribute specification" vhdl-template-attribute-spec) |
| 3027 | ("block configuration" vhdl-template-block-configuration) |
| 3028 | ("block statement" vhdl-template-block) |
| 3029 | ("case statement" vhdl-template-case-is) |
| 3030 | ("component configuration" vhdl-template-component-conf) |
| 3031 | ("component declaration" vhdl-template-component-decl) |
| 3032 | ("component instantiation statement" vhdl-template-component-inst) |
| 3033 | ("conditional signal assignment" vhdl-template-conditional-signal-asst) |
| 3034 | ("configuration declaration" vhdl-template-configuration-decl) |
| 3035 | ("configuration specification" vhdl-template-configuration-spec) |
| 3036 | ("constant declaration" vhdl-template-constant) |
| 3037 | ("disconnection specification" vhdl-template-disconnect) |
| 3038 | ("entity declaration" vhdl-template-entity) |
| 3039 | ("exit statement" vhdl-template-exit) |
| 3040 | ("file declaration" vhdl-template-file) |
| 3041 | ("generate statement" vhdl-template-generate) |
| 3042 | ("generic clause" vhdl-template-generic) |
| 3043 | ("group declaration" vhdl-template-group-decl) |
| 3044 | ("group template declaration" vhdl-template-group-template) |
| 3045 | ("if statement" vhdl-template-if-then) |
| 3046 | ("library clause" vhdl-template-library) |
| 3047 | ("loop statement" vhdl-template-loop) |
| 3048 | ("next statement" vhdl-template-next) |
| 3049 | ("package declaration" vhdl-template-package-decl) |
| 3050 | ("package body" vhdl-template-package-body) |
| 3051 | ("port clause" vhdl-template-port) |
| 3052 | ("process statement" vhdl-template-process) |
| 3053 | ("report statement" vhdl-template-report) |
| 3054 | ("return statement" vhdl-template-return) |
| 3055 | ("selected signal assignment" vhdl-template-selected-signal-asst) |
| 3056 | ("signal declaration" vhdl-template-signal) |
| 3057 | ("subprogram declaration" vhdl-template-subprogram-decl) |
| 3058 | ("subprogram body" vhdl-template-subprogram-body) |
| 3059 | ("subtype declaration" vhdl-template-subtype) |
| 3060 | ("type declaration" vhdl-template-type) |
| 3061 | ("use clause" vhdl-template-use) |
| 3062 | ("variable declaration" vhdl-template-variable) |
| 3063 | ("wait statement" vhdl-template-wait) |
| 3064 | ) |
| 3065 | (when (vhdl-standard-p 'ams) |
| 3066 | '( |
| 3067 | ("break statement" vhdl-template-break) |
| 3068 | ("nature declaration" vhdl-template-nature) |
| 3069 | ("quantity declaration" vhdl-template-quantity) |
| 3070 | ("simultaneous case statement" vhdl-template-case-use) |
| 3071 | ("simultaneous if statement" vhdl-template-if-use) |
| 3072 | ("simultaneous procedural statement" vhdl-template-procedural) |
| 3073 | ("step limit specification" vhdl-template-limit) |
| 3074 | ("subnature declaration" vhdl-template-subnature) |
| 3075 | ("terminal declaration" vhdl-template-terminal) |
| 3076 | ))))) |
| 3077 | |
| 3078 | ;; initialize for VHDL Mode |
| 3079 | (vhdl-template-construct-alist-init) |
| 3080 | |
| 3081 | (defvar vhdl-template-package-alist nil |
| 3082 | "List of built-in package templates.") |
| 3083 | |
| 3084 | (defun vhdl-template-package-alist-init () |
| 3085 | "Initialize `vhdl-template-package-alist'." |
| 3086 | (setq |
| 3087 | vhdl-template-package-alist |
| 3088 | (append |
| 3089 | '( |
| 3090 | ("numeric_bit" vhdl-template-package-numeric-bit) |
| 3091 | ("numeric_std" vhdl-template-package-numeric-std) |
| 3092 | ("std_logic_1164" vhdl-template-package-std-logic-1164) |
| 3093 | ("std_logic_arith" vhdl-template-package-std-logic-arith) |
| 3094 | ("std_logic_misc" vhdl-template-package-std-logic-misc) |
| 3095 | ("std_logic_signed" vhdl-template-package-std-logic-signed) |
| 3096 | ("std_logic_textio" vhdl-template-package-std-logic-textio) |
| 3097 | ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) |
| 3098 | ("textio" vhdl-template-package-textio) |
| 3099 | ) |
| 3100 | (when (vhdl-standard-p 'math) |
| 3101 | '( |
| 3102 | ("math_complex" vhdl-template-package-math-complex) |
| 3103 | ("math_real" vhdl-template-package-math-real) |
| 3104 | ))))) |
| 3105 | |
| 3106 | ;; initialize for VHDL Mode |
| 3107 | (vhdl-template-package-alist-init) |
| 3108 | |
| 3109 | (defvar vhdl-template-directive-alist |
| 3110 | '( |
| 3111 | ("translate_on" vhdl-template-directive-translate-on) |
| 3112 | ("translate_off" vhdl-template-directive-translate-off) |
| 3113 | ("synthesis_on" vhdl-template-directive-synthesis-on) |
| 3114 | ("synthesis_off" vhdl-template-directive-synthesis-off) |
| 3115 | ) |
| 3116 | "List of built-in directive templates.") |
| 3117 | |
| 3118 | |
| 3119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3120 | ;;; Menus |
| 3121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3122 | |
| 3123 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3124 | ;; VHDL menu (using `easy-menu.el') |
| 3125 | |
| 3126 | (defun vhdl-customize () |
| 3127 | "Call the customize function with `vhdl' as argument." |
| 3128 | (interactive) |
| 3129 | (customize-browse 'vhdl)) |
| 3130 | |
| 3131 | (defun vhdl-create-mode-menu () |
| 3132 | "Create VHDL Mode menu." |
| 3133 | `("VHDL" |
| 3134 | ,(append |
| 3135 | '("Project" |
| 3136 | ["None" (vhdl-set-project "") |
| 3137 | :style radio :selected (null vhdl-project)] |
| 3138 | "--") |
| 3139 | ;; add menu entries for defined projects |
| 3140 | (let ((project-alist vhdl-project-alist) menu-list name) |
| 3141 | (while project-alist |
| 3142 | (setq name (caar project-alist)) |
| 3143 | (setq menu-list |
| 3144 | (cons `[,name (vhdl-set-project ,name) |
| 3145 | :style radio :selected (equal ,name vhdl-project)] |
| 3146 | menu-list)) |
| 3147 | (setq project-alist (cdr project-alist))) |
| 3148 | (setq menu-list |
| 3149 | (if vhdl-project-sort |
| 3150 | (sort menu-list |
| 3151 | (function (lambda (a b) (string< (elt a 0) (elt b 0))))) |
| 3152 | (nreverse menu-list))) |
| 3153 | (vhdl-menu-split menu-list "Project")) |
| 3154 | '("--" "--" |
| 3155 | ["Select Project..." vhdl-set-project t] |
| 3156 | ["Set As Default Project" vhdl-set-default-project t] |
| 3157 | "--" |
| 3158 | ["Duplicate Project" vhdl-duplicate-project vhdl-project] |
| 3159 | ["Import Project..." vhdl-import-project |
| 3160 | :keys "C-c C-p C-m" :active t] |
| 3161 | ["Export Project" vhdl-export-project vhdl-project] |
| 3162 | "--" |
| 3163 | ["Customize Project..." (customize-option 'vhdl-project-alist) t])) |
| 3164 | "--" |
| 3165 | ("Compile" |
| 3166 | ["Compile Buffer" vhdl-compile t] |
| 3167 | ["Stop Compilation" kill-compilation t] |
| 3168 | "--" |
| 3169 | ["Make" vhdl-make t] |
| 3170 | ["Generate Makefile" vhdl-generate-makefile t] |
| 3171 | "--" |
| 3172 | ["Next Error" next-error t] |
| 3173 | ["Previous Error" previous-error t] |
| 3174 | ["First Error" first-error t] |
| 3175 | "--" |
| 3176 | ,(append |
| 3177 | '("Compiler") |
| 3178 | ;; add menu entries for defined compilers |
| 3179 | (let ((comp-alist vhdl-compiler-alist) menu-list name) |
| 3180 | (while comp-alist |
| 3181 | (setq name (caar comp-alist)) |
| 3182 | (setq menu-list |
| 3183 | (cons `[,name (setq vhdl-compiler ,name) |
| 3184 | :style radio :selected (equal ,name vhdl-compiler)] |
| 3185 | menu-list)) |
| 3186 | (setq comp-alist (cdr comp-alist))) |
| 3187 | (setq menu-list (nreverse menu-list)) |
| 3188 | (vhdl-menu-split menu-list "Compiler")) |
| 3189 | '("--" "--" |
| 3190 | ["Select Compiler..." vhdl-set-compiler t] |
| 3191 | "--" |
| 3192 | ["Customize Compiler..." |
| 3193 | (customize-option 'vhdl-compiler-alist) t]))) |
| 3194 | "--" |
| 3195 | ,(append |
| 3196 | '("Template" |
| 3197 | ("VHDL Construct 1" |
| 3198 | ["Alias" vhdl-template-alias t] |
| 3199 | ["Architecture" vhdl-template-architecture t] |
| 3200 | ["Assert" vhdl-template-assert t] |
| 3201 | ["Attribute (Decl)" vhdl-template-attribute-decl t] |
| 3202 | ["Attribute (Spec)" vhdl-template-attribute-spec t] |
| 3203 | ["Block" vhdl-template-block t] |
| 3204 | ["Case" vhdl-template-case-is t] |
| 3205 | ["Component (Decl)" vhdl-template-component-decl t] |
| 3206 | ["(Component) Instance" vhdl-template-component-inst t] |
| 3207 | ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] |
| 3208 | ["Configuration (Block)" vhdl-template-block-configuration t] |
| 3209 | ["Configuration (Comp)" vhdl-template-component-conf t] |
| 3210 | ["Configuration (Decl)" vhdl-template-configuration-decl t] |
| 3211 | ["Configuration (Spec)" vhdl-template-configuration-spec t] |
| 3212 | ["Constant" vhdl-template-constant t] |
| 3213 | ["Disconnect" vhdl-template-disconnect t] |
| 3214 | ["Else" vhdl-template-else t] |
| 3215 | ["Elsif" vhdl-template-elsif t] |
| 3216 | ["Entity" vhdl-template-entity t] |
| 3217 | ["Exit" vhdl-template-exit t] |
| 3218 | ["File" vhdl-template-file t] |
| 3219 | ["For (Generate)" vhdl-template-for-generate t] |
| 3220 | ["For (Loop)" vhdl-template-for-loop t] |
| 3221 | ["Function (Body)" vhdl-template-function-body t] |
| 3222 | ["Function (Decl)" vhdl-template-function-decl t] |
| 3223 | ["Generic" vhdl-template-generic t] |
| 3224 | ["Group (Decl)" vhdl-template-group-decl t] |
| 3225 | ["Group (Template)" vhdl-template-group-template t]) |
| 3226 | ("VHDL Construct 2" |
| 3227 | ["If (Generate)" vhdl-template-if-generate t] |
| 3228 | ["If (Then)" vhdl-template-if-then t] |
| 3229 | ["Library" vhdl-template-library t] |
| 3230 | ["Loop" vhdl-template-bare-loop t] |
| 3231 | ["Map" vhdl-template-map t] |
| 3232 | ["Next" vhdl-template-next t] |
| 3233 | ["Others (Aggregate)" vhdl-template-others t] |
| 3234 | ["Package (Decl)" vhdl-template-package-decl t] |
| 3235 | ["Package (Body)" vhdl-template-package-body t] |
| 3236 | ["Port" vhdl-template-port t] |
| 3237 | ["Procedure (Body)" vhdl-template-procedure-body t] |
| 3238 | ["Procedure (Decl)" vhdl-template-procedure-decl t] |
| 3239 | ["Process (Comb)" vhdl-template-process-comb t] |
| 3240 | ["Process (Seq)" vhdl-template-process-seq t] |
| 3241 | ["Report" vhdl-template-report t] |
| 3242 | ["Return" vhdl-template-return t] |
| 3243 | ["Select" vhdl-template-selected-signal-asst t] |
| 3244 | ["Signal" vhdl-template-signal t] |
| 3245 | ["Subtype" vhdl-template-subtype t] |
| 3246 | ["Type" vhdl-template-type t] |
| 3247 | ["Use" vhdl-template-use t] |
| 3248 | ["Variable" vhdl-template-variable t] |
| 3249 | ["Wait" vhdl-template-wait t] |
| 3250 | ["(Clocked Wait)" vhdl-template-clocked-wait t] |
| 3251 | ["When" vhdl-template-when t] |
| 3252 | ["While (Loop)" vhdl-template-while-loop t] |
| 3253 | ["With" vhdl-template-with t])) |
| 3254 | (when (vhdl-standard-p 'ams) |
| 3255 | '(("VHDL-AMS Construct" |
| 3256 | ["Break" vhdl-template-break t] |
| 3257 | ["Case (Use)" vhdl-template-case-use t] |
| 3258 | ["If (Use)" vhdl-template-if-use t] |
| 3259 | ["Limit" vhdl-template-limit t] |
| 3260 | ["Nature" vhdl-template-nature t] |
| 3261 | ["Procedural" vhdl-template-procedural t] |
| 3262 | ["Quantity (Free)" vhdl-template-quantity-free t] |
| 3263 | ["Quantity (Branch)" vhdl-template-quantity-branch t] |
| 3264 | ["Quantity (Source)" vhdl-template-quantity-source t] |
| 3265 | ["Subnature" vhdl-template-subnature t] |
| 3266 | ["Terminal" vhdl-template-terminal t]))) |
| 3267 | '(["Insert Construct..." vhdl-template-insert-construct |
| 3268 | :keys "C-c C-i C-t"] |
| 3269 | "--") |
| 3270 | (list |
| 3271 | (append |
| 3272 | '("Package") |
| 3273 | (when (vhdl-standard-p 'math) |
| 3274 | '(["math_complex" vhdl-template-package-math-complex t] |
| 3275 | ["math_real" vhdl-template-package-math-real t])) |
| 3276 | '(["numeric_bit" vhdl-template-package-numeric-bit t] |
| 3277 | ["numeric_std" vhdl-template-package-numeric-std t] |
| 3278 | ["std_logic_1164" vhdl-template-package-std-logic-1164 t] |
| 3279 | ["textio" vhdl-template-package-textio t] |
| 3280 | "--" |
| 3281 | ["std_logic_arith" vhdl-template-package-std-logic-arith t] |
| 3282 | ["std_logic_signed" vhdl-template-package-std-logic-signed t] |
| 3283 | ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] |
| 3284 | ["std_logic_misc" vhdl-template-package-std-logic-misc t] |
| 3285 | ["std_logic_textio" vhdl-template-package-std-logic-textio t] |
| 3286 | "--" |
| 3287 | ["Insert Package..." vhdl-template-insert-package |
| 3288 | :keys "C-c C-i C-p"]))) |
| 3289 | '(("Directive" |
| 3290 | ["translate_on" vhdl-template-directive-translate-on t] |
| 3291 | ["translate_off" vhdl-template-directive-translate-off t] |
| 3292 | ["synthesis_on" vhdl-template-directive-synthesis-on t] |
| 3293 | ["synthesis_off" vhdl-template-directive-synthesis-off t] |
| 3294 | "--" |
| 3295 | ["Insert Directive..." vhdl-template-insert-directive |
| 3296 | :keys "C-c C-i C-d"]) |
| 3297 | "--" |
| 3298 | ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] |
| 3299 | ["Insert Footer" vhdl-template-footer t] |
| 3300 | ["Insert Date" vhdl-template-insert-date t] |
| 3301 | ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] |
| 3302 | "--" |
| 3303 | ["Query Next Prompt" vhdl-template-search-prompt t])) |
| 3304 | ,(append |
| 3305 | '("Model") |
| 3306 | ;; add menu entries for defined models |
| 3307 | (let ((model-alist vhdl-model-alist) menu-list model) |
| 3308 | (while model-alist |
| 3309 | (setq model (car model-alist)) |
| 3310 | (setq menu-list |
| 3311 | (cons |
| 3312 | (vector |
| 3313 | (nth 0 model) |
| 3314 | (vhdl-function-name "vhdl-model" (nth 0 model)) |
| 3315 | :keys (concat "C-c C-m " (key-description (nth 2 model)))) |
| 3316 | menu-list)) |
| 3317 | (setq model-alist (cdr model-alist))) |
| 3318 | (setq menu-list (nreverse menu-list)) |
| 3319 | (vhdl-menu-split menu-list "Model")) |
| 3320 | '("--" "--" |
| 3321 | ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] |
| 3322 | ["Customize Model..." (customize-option 'vhdl-model-alist) t])) |
| 3323 | ("Port" |
| 3324 | ["Copy" vhdl-port-copy t] |
| 3325 | "--" |
| 3326 | ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] |
| 3327 | ["Paste As Component" vhdl-port-paste-component vhdl-port-list] |
| 3328 | ["Paste As Instance" vhdl-port-paste-instance |
| 3329 | :keys "C-c C-p C-i" :active vhdl-port-list] |
| 3330 | ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] |
| 3331 | ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] |
| 3332 | ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] |
| 3333 | ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] |
| 3334 | "--" |
| 3335 | ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] |
| 3336 | "--" |
| 3337 | ["Flatten" vhdl-port-flatten |
| 3338 | :style toggle :selected vhdl-port-flattened :active vhdl-port-list] |
| 3339 | ["Reverse Direction" vhdl-port-reverse-direction |
| 3340 | :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) |
| 3341 | ("Compose" |
| 3342 | ["New Component" vhdl-compose-new-component t] |
| 3343 | ["Copy Component" vhdl-port-copy t] |
| 3344 | ["Place Component" vhdl-compose-place-component vhdl-port-list] |
| 3345 | ["Wire Components" vhdl-compose-wire-components t] |
| 3346 | "--" |
| 3347 | ["Generate Configuration" vhdl-compose-configuration t] |
| 3348 | ["Generate Components Package" vhdl-compose-components-package t]) |
| 3349 | ("Subprogram" |
| 3350 | ["Copy" vhdl-subprog-copy t] |
| 3351 | "--" |
| 3352 | ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] |
| 3353 | ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] |
| 3354 | ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] |
| 3355 | "--" |
| 3356 | ["Flatten" vhdl-subprog-flatten |
| 3357 | :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) |
| 3358 | "--" |
| 3359 | ("Comment" |
| 3360 | ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] |
| 3361 | "--" |
| 3362 | ["Insert Inline Comment" vhdl-comment-append-inline t] |
| 3363 | ["Insert Horizontal Line" vhdl-comment-display-line t] |
| 3364 | ["Insert Display Comment" vhdl-comment-display t] |
| 3365 | "--" |
| 3366 | ["Fill Comment" fill-paragraph t] |
| 3367 | ["Fill Comment Region" fill-region (mark)] |
| 3368 | ["Kill Comment Region" vhdl-comment-kill-region (mark)] |
| 3369 | ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) |
| 3370 | ("Line" |
| 3371 | ["Kill" vhdl-line-kill t] |
| 3372 | ["Copy" vhdl-line-copy t] |
| 3373 | ["Yank" vhdl-line-yank t] |
| 3374 | ["Expand" vhdl-line-expand t] |
| 3375 | "--" |
| 3376 | ["Transpose Next" vhdl-line-transpose-next t] |
| 3377 | ["Transpose Prev" vhdl-line-transpose-previous t] |
| 3378 | ["Open" vhdl-line-open t] |
| 3379 | ["Join" vhdl-delete-indentation t] |
| 3380 | "--" |
| 3381 | ["Goto" goto-line t] |
| 3382 | ["(Un)Comment Out" vhdl-comment-uncomment-line t]) |
| 3383 | ("Move" |
| 3384 | ["Forward Statement" vhdl-end-of-statement t] |
| 3385 | ["Backward Statement" vhdl-beginning-of-statement t] |
| 3386 | ["Forward Expression" vhdl-forward-sexp t] |
| 3387 | ["Backward Expression" vhdl-backward-sexp t] |
| 3388 | ["Forward Same Indent" vhdl-forward-same-indent t] |
| 3389 | ["Backward Same Indent" vhdl-backward-same-indent t] |
| 3390 | ["Forward Function" vhdl-end-of-defun t] |
| 3391 | ["Backward Function" vhdl-beginning-of-defun t] |
| 3392 | ["Mark Function" vhdl-mark-defun t]) |
| 3393 | "--" |
| 3394 | ("Indent" |
| 3395 | ["Line" indent-according-to-mode :keys "C-c C-i C-l"] |
| 3396 | ["Group" vhdl-indent-group :keys "C-c C-i C-g"] |
| 3397 | ["Region" vhdl-indent-region (mark)] |
| 3398 | ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) |
| 3399 | ("Align" |
| 3400 | ["Group" vhdl-align-group t] |
| 3401 | ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] |
| 3402 | ["List" vhdl-align-list t] |
| 3403 | ["Declarations" vhdl-align-declarations t] |
| 3404 | ["Region" vhdl-align-region (mark)] |
| 3405 | ["Buffer" vhdl-align-buffer t] |
| 3406 | "--" |
| 3407 | ["Inline Comment Group" vhdl-align-inline-comment-group t] |
| 3408 | ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] |
| 3409 | ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) |
| 3410 | ("Fill" |
| 3411 | ["List" vhdl-fill-list t] |
| 3412 | ["Group" vhdl-fill-group t] |
| 3413 | ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] |
| 3414 | ["Region" vhdl-fill-region (mark)]) |
| 3415 | ("Beautify" |
| 3416 | ["Region" vhdl-beautify-region (mark)] |
| 3417 | ["Buffer" vhdl-beautify-buffer t]) |
| 3418 | ("Fix" |
| 3419 | ["Generic/Port Clause" vhdl-fix-clause t] |
| 3420 | "--" |
| 3421 | ["Case Region" vhdl-fix-case-region (mark)] |
| 3422 | ["Case Buffer" vhdl-fix-case-buffer t] |
| 3423 | "--" |
| 3424 | ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] |
| 3425 | ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] |
| 3426 | "--" |
| 3427 | ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) |
| 3428 | ("Update" |
| 3429 | ["Sensitivity List" vhdl-update-sensitivity-list-process t] |
| 3430 | ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) |
| 3431 | "--" |
| 3432 | ["Fontify Buffer" vhdl-fontify-buffer t] |
| 3433 | ["Statistics Buffer" vhdl-statistics-buffer t] |
| 3434 | ["Show Messages" vhdl-show-messages t] |
| 3435 | ["Syntactic Info" vhdl-show-syntactic-information t] |
| 3436 | "--" |
| 3437 | ["Speedbar" vhdl-speedbar t] |
| 3438 | ["Hide/Show" vhdl-hs-minor-mode t] |
| 3439 | "--" |
| 3440 | ("Documentation" |
| 3441 | ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] |
| 3442 | ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] |
| 3443 | ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] |
| 3444 | ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) |
| 3445 | ["Version" vhdl-version t] |
| 3446 | ["Bug Report..." vhdl-submit-bug-report t] |
| 3447 | "--" |
| 3448 | ("Options" |
| 3449 | ("Mode" |
| 3450 | ["Electric Mode" |
| 3451 | (progn (customize-set-variable 'vhdl-electric-mode |
| 3452 | (not vhdl-electric-mode))) |
| 3453 | :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] |
| 3454 | ["Stutter Mode" |
| 3455 | (progn (customize-set-variable 'vhdl-stutter-mode |
| 3456 | (not vhdl-stutter-mode))) |
| 3457 | :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] |
| 3458 | ["Indent Tabs Mode" |
| 3459 | (progn (customize-set-variable 'vhdl-indent-tabs-mode |
| 3460 | (not vhdl-indent-tabs-mode)) |
| 3461 | (setq indent-tabs-mode vhdl-indent-tabs-mode)) |
| 3462 | :style toggle :selected vhdl-indent-tabs-mode] |
| 3463 | "--" |
| 3464 | ["Customize Group..." (customize-group 'vhdl-mode) t]) |
| 3465 | ("Project" |
| 3466 | ["Project Setup..." (customize-option 'vhdl-project-alist) t] |
| 3467 | ,(append |
| 3468 | '("Selected Project at Startup" |
| 3469 | ["None" (progn (customize-set-variable 'vhdl-project nil) |
| 3470 | (vhdl-set-project "")) |
| 3471 | :style radio :selected (null vhdl-project)] |
| 3472 | "--") |
| 3473 | ;; add menu entries for defined projects |
| 3474 | (let ((project-alist vhdl-project-alist) menu-list name) |
| 3475 | (while project-alist |
| 3476 | (setq name (caar project-alist)) |
| 3477 | (setq menu-list |
| 3478 | (cons `[,name (progn (customize-set-variable |
| 3479 | 'vhdl-project ,name) |
| 3480 | (vhdl-set-project ,name)) |
| 3481 | :style radio :selected (equal ,name vhdl-project)] |
| 3482 | menu-list)) |
| 3483 | (setq project-alist (cdr project-alist))) |
| 3484 | (setq menu-list (nreverse menu-list)) |
| 3485 | (vhdl-menu-split menu-list "Project"))) |
| 3486 | ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] |
| 3487 | ("Auto Load Setup File" |
| 3488 | ["At Startup" |
| 3489 | (customize-set-variable 'vhdl-project-auto-load |
| 3490 | (if (memq 'startup vhdl-project-auto-load) |
| 3491 | (delq 'startup vhdl-project-auto-load) |
| 3492 | (cons 'startup vhdl-project-auto-load))) |
| 3493 | :style toggle :selected (memq 'startup vhdl-project-auto-load)]) |
| 3494 | ["Sort Projects" |
| 3495 | (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) |
| 3496 | :style toggle :selected vhdl-project-sort] |
| 3497 | "--" |
| 3498 | ["Customize Group..." (customize-group 'vhdl-project) t]) |
| 3499 | ("Compiler" |
| 3500 | ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] |
| 3501 | ,(append |
| 3502 | '("Selected Compiler at Startup") |
| 3503 | ;; add menu entries for defined compilers |
| 3504 | (let ((comp-alist vhdl-compiler-alist) menu-list name) |
| 3505 | (while comp-alist |
| 3506 | (setq name (caar comp-alist)) |
| 3507 | (setq menu-list |
| 3508 | (cons `[,name (customize-set-variable 'vhdl-compiler ,name) |
| 3509 | :style radio :selected (equal ,name vhdl-compiler)] |
| 3510 | menu-list)) |
| 3511 | (setq comp-alist (cdr comp-alist))) |
| 3512 | (setq menu-list (nreverse menu-list)) |
| 3513 | (vhdl-menu-split menu-list "Compiler"))) |
| 3514 | ["Use Local Error Regexp" |
| 3515 | (customize-set-variable 'vhdl-compile-use-local-error-regexp |
| 3516 | (not vhdl-compile-use-local-error-regexp)) |
| 3517 | :style toggle :selected vhdl-compile-use-local-error-regexp] |
| 3518 | ["Makefile Generation Hook..." |
| 3519 | (customize-option 'vhdl-makefile-generation-hook) t] |
| 3520 | ["Default Library Name" (customize-option 'vhdl-default-library) t] |
| 3521 | "--" |
| 3522 | ["Customize Group..." (customize-group 'vhdl-compiler) t]) |
| 3523 | ("Style" |
| 3524 | ("VHDL Standard" |
| 3525 | ["VHDL'87" |
| 3526 | (progn (customize-set-variable 'vhdl-standard |
| 3527 | (list '87 (cadr vhdl-standard))) |
| 3528 | (vhdl-activate-customizations)) |
| 3529 | :style radio :selected (eq '87 (car vhdl-standard))] |
| 3530 | ["VHDL'93" |
| 3531 | (progn (customize-set-variable 'vhdl-standard |
| 3532 | (list '93 (cadr vhdl-standard))) |
| 3533 | (vhdl-activate-customizations)) |
| 3534 | :style radio :selected (eq '93 (car vhdl-standard))] |
| 3535 | "--" |
| 3536 | ["VHDL-AMS" |
| 3537 | (progn (customize-set-variable |
| 3538 | 'vhdl-standard (list (car vhdl-standard) |
| 3539 | (if (memq 'ams (cadr vhdl-standard)) |
| 3540 | (delq 'ams (cadr vhdl-standard)) |
| 3541 | (cons 'ams (cadr vhdl-standard))))) |
| 3542 | (vhdl-activate-customizations)) |
| 3543 | :style toggle :selected (memq 'ams (cadr vhdl-standard))] |
| 3544 | ["Math Packages" |
| 3545 | (progn (customize-set-variable |
| 3546 | 'vhdl-standard (list (car vhdl-standard) |
| 3547 | (if (memq 'math (cadr vhdl-standard)) |
| 3548 | (delq 'math (cadr vhdl-standard)) |
| 3549 | (cons 'math (cadr vhdl-standard))))) |
| 3550 | (vhdl-activate-customizations)) |
| 3551 | :style toggle :selected (memq 'math (cadr vhdl-standard))]) |
| 3552 | ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] |
| 3553 | ["Upper Case Keywords" |
| 3554 | (customize-set-variable 'vhdl-upper-case-keywords |
| 3555 | (not vhdl-upper-case-keywords)) |
| 3556 | :style toggle :selected vhdl-upper-case-keywords] |
| 3557 | ["Upper Case Types" |
| 3558 | (customize-set-variable 'vhdl-upper-case-types |
| 3559 | (not vhdl-upper-case-types)) |
| 3560 | :style toggle :selected vhdl-upper-case-types] |
| 3561 | ["Upper Case Attributes" |
| 3562 | (customize-set-variable 'vhdl-upper-case-attributes |
| 3563 | (not vhdl-upper-case-attributes)) |
| 3564 | :style toggle :selected vhdl-upper-case-attributes] |
| 3565 | ["Upper Case Enumeration Values" |
| 3566 | (customize-set-variable 'vhdl-upper-case-enum-values |
| 3567 | (not vhdl-upper-case-enum-values)) |
| 3568 | :style toggle :selected vhdl-upper-case-enum-values] |
| 3569 | ["Upper Case Constants" |
| 3570 | (customize-set-variable 'vhdl-upper-case-constants |
| 3571 | (not vhdl-upper-case-constants)) |
| 3572 | :style toggle :selected vhdl-upper-case-constants] |
| 3573 | ("Use Direct Instantiation" |
| 3574 | ["Never" |
| 3575 | (customize-set-variable 'vhdl-use-direct-instantiation 'never) |
| 3576 | :style radio :selected (eq 'never vhdl-use-direct-instantiation)] |
| 3577 | ["Standard" |
| 3578 | (customize-set-variable 'vhdl-use-direct-instantiation 'standard) |
| 3579 | :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] |
| 3580 | ["Always" |
| 3581 | (customize-set-variable 'vhdl-use-direct-instantiation 'always) |
| 3582 | :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) |
| 3583 | "--" |
| 3584 | ["Customize Group..." (customize-group 'vhdl-style) t]) |
| 3585 | ("Naming" |
| 3586 | ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] |
| 3587 | ["Architecture File Name..." |
| 3588 | (customize-option 'vhdl-architecture-file-name) t] |
| 3589 | ["Configuration File Name..." |
| 3590 | (customize-option 'vhdl-configuration-file-name) t] |
| 3591 | ["Package File Name..." (customize-option 'vhdl-package-file-name) t] |
| 3592 | ("File Name Case" |
| 3593 | ["As Is" |
| 3594 | (customize-set-variable 'vhdl-file-name-case 'identity) |
| 3595 | :style radio :selected (eq 'identity vhdl-file-name-case)] |
| 3596 | ["Lower Case" |
| 3597 | (customize-set-variable 'vhdl-file-name-case 'downcase) |
| 3598 | :style radio :selected (eq 'downcase vhdl-file-name-case)] |
| 3599 | ["Upper Case" |
| 3600 | (customize-set-variable 'vhdl-file-name-case 'upcase) |
| 3601 | :style radio :selected (eq 'upcase vhdl-file-name-case)] |
| 3602 | ["Capitalize" |
| 3603 | (customize-set-variable 'vhdl-file-name-case 'capitalize) |
| 3604 | :style radio :selected (eq 'capitalize vhdl-file-name-case)]) |
| 3605 | "--" |
| 3606 | ["Customize Group..." (customize-group 'vhdl-naming) t]) |
| 3607 | ("Template" |
| 3608 | ("Electric Keywords" |
| 3609 | ["VHDL Keywords" |
| 3610 | (customize-set-variable 'vhdl-electric-keywords |
| 3611 | (if (memq 'vhdl vhdl-electric-keywords) |
| 3612 | (delq 'vhdl vhdl-electric-keywords) |
| 3613 | (cons 'vhdl vhdl-electric-keywords))) |
| 3614 | :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] |
| 3615 | ["User Model Keywords" |
| 3616 | (customize-set-variable 'vhdl-electric-keywords |
| 3617 | (if (memq 'user vhdl-electric-keywords) |
| 3618 | (delq 'user vhdl-electric-keywords) |
| 3619 | (cons 'user vhdl-electric-keywords))) |
| 3620 | :style toggle :selected (memq 'user vhdl-electric-keywords)]) |
| 3621 | ("Insert Optional Labels" |
| 3622 | ["None" |
| 3623 | (customize-set-variable 'vhdl-optional-labels 'none) |
| 3624 | :style radio :selected (eq 'none vhdl-optional-labels)] |
| 3625 | ["Processes Only" |
| 3626 | (customize-set-variable 'vhdl-optional-labels 'process) |
| 3627 | :style radio :selected (eq 'process vhdl-optional-labels)] |
| 3628 | ["All Constructs" |
| 3629 | (customize-set-variable 'vhdl-optional-labels 'all) |
| 3630 | :style radio :selected (eq 'all vhdl-optional-labels)]) |
| 3631 | ("Insert Empty Lines" |
| 3632 | ["None" |
| 3633 | (customize-set-variable 'vhdl-insert-empty-lines 'none) |
| 3634 | :style radio :selected (eq 'none vhdl-insert-empty-lines)] |
| 3635 | ["Design Units Only" |
| 3636 | (customize-set-variable 'vhdl-insert-empty-lines 'unit) |
| 3637 | :style radio :selected (eq 'unit vhdl-insert-empty-lines)] |
| 3638 | ["All Constructs" |
| 3639 | (customize-set-variable 'vhdl-insert-empty-lines 'all) |
| 3640 | :style radio :selected (eq 'all vhdl-insert-empty-lines)]) |
| 3641 | ["Argument List Indent" |
| 3642 | (customize-set-variable 'vhdl-argument-list-indent |
| 3643 | (not vhdl-argument-list-indent)) |
| 3644 | :style toggle :selected vhdl-argument-list-indent] |
| 3645 | ["Association List with Formals" |
| 3646 | (customize-set-variable 'vhdl-association-list-with-formals |
| 3647 | (not vhdl-association-list-with-formals)) |
| 3648 | :style toggle :selected vhdl-association-list-with-formals] |
| 3649 | ["Conditions in Parenthesis" |
| 3650 | (customize-set-variable 'vhdl-conditions-in-parenthesis |
| 3651 | (not vhdl-conditions-in-parenthesis)) |
| 3652 | :style toggle :selected vhdl-conditions-in-parenthesis] |
| 3653 | ["Zero String..." (customize-option 'vhdl-zero-string) t] |
| 3654 | ["One String..." (customize-option 'vhdl-one-string) t] |
| 3655 | ("File Header" |
| 3656 | ["Header String..." (customize-option 'vhdl-file-header) t] |
| 3657 | ["Footer String..." (customize-option 'vhdl-file-footer) t] |
| 3658 | ["Company Name..." (customize-option 'vhdl-company-name) t] |
| 3659 | ["Copyright String..." (customize-option 'vhdl-copyright-string) t] |
| 3660 | ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] |
| 3661 | ["Date Format..." (customize-option 'vhdl-date-format) t] |
| 3662 | ["Modify Date Prefix String..." |
| 3663 | (customize-option 'vhdl-modify-date-prefix-string) t] |
| 3664 | ["Modify Date on Saving" |
| 3665 | (progn (customize-set-variable 'vhdl-modify-date-on-saving |
| 3666 | (not vhdl-modify-date-on-saving)) |
| 3667 | (vhdl-activate-customizations)) |
| 3668 | :style toggle :selected vhdl-modify-date-on-saving]) |
| 3669 | ("Sequential Process" |
| 3670 | ("Kind of Reset" |
| 3671 | ["None" |
| 3672 | (customize-set-variable 'vhdl-reset-kind 'none) |
| 3673 | :style radio :selected (eq 'none vhdl-reset-kind)] |
| 3674 | ["Synchronous" |
| 3675 | (customize-set-variable 'vhdl-reset-kind 'sync) |
| 3676 | :style radio :selected (eq 'sync vhdl-reset-kind)] |
| 3677 | ["Asynchronous" |
| 3678 | (customize-set-variable 'vhdl-reset-kind 'async) |
| 3679 | :style radio :selected (eq 'async vhdl-reset-kind)]) |
| 3680 | ["Reset is Active High" |
| 3681 | (customize-set-variable 'vhdl-reset-active-high |
| 3682 | (not vhdl-reset-active-high)) |
| 3683 | :style toggle :selected vhdl-reset-active-high] |
| 3684 | ["Use Rising Clock Edge" |
| 3685 | (customize-set-variable 'vhdl-clock-rising-edge |
| 3686 | (not vhdl-clock-rising-edge)) |
| 3687 | :style toggle :selected vhdl-clock-rising-edge] |
| 3688 | ("Clock Edge Condition" |
| 3689 | ["Standard" |
| 3690 | (customize-set-variable 'vhdl-clock-edge-condition 'standard) |
| 3691 | :style radio :selected (eq 'standard vhdl-clock-edge-condition)] |
| 3692 | ["Function \"rising_edge\"" |
| 3693 | (customize-set-variable 'vhdl-clock-edge-condition 'function) |
| 3694 | :style radio :selected (eq 'function vhdl-clock-edge-condition)]) |
| 3695 | ["Clock Name..." (customize-option 'vhdl-clock-name) t] |
| 3696 | ["Reset Name..." (customize-option 'vhdl-reset-name) t]) |
| 3697 | "--" |
| 3698 | ["Customize Group..." (customize-group 'vhdl-template) t]) |
| 3699 | ("Model" |
| 3700 | ["Model Definition..." (customize-option 'vhdl-model-alist) t]) |
| 3701 | ("Port" |
| 3702 | ["Include Port Comments" |
| 3703 | (customize-set-variable 'vhdl-include-port-comments |
| 3704 | (not vhdl-include-port-comments)) |
| 3705 | :style toggle :selected vhdl-include-port-comments] |
| 3706 | ["Include Direction Comments" |
| 3707 | (customize-set-variable 'vhdl-include-direction-comments |
| 3708 | (not vhdl-include-direction-comments)) |
| 3709 | :style toggle :selected vhdl-include-direction-comments] |
| 3710 | ["Include Type Comments" |
| 3711 | (customize-set-variable 'vhdl-include-type-comments |
| 3712 | (not vhdl-include-type-comments)) |
| 3713 | :style toggle :selected vhdl-include-type-comments] |
| 3714 | ("Include Group Comments" |
| 3715 | ["Never" |
| 3716 | (customize-set-variable 'vhdl-include-group-comments 'never) |
| 3717 | :style radio :selected (eq 'never vhdl-include-group-comments)] |
| 3718 | ["Declarations" |
| 3719 | (customize-set-variable 'vhdl-include-group-comments 'decl) |
| 3720 | :style radio :selected (eq 'decl vhdl-include-group-comments)] |
| 3721 | ["Always" |
| 3722 | (customize-set-variable 'vhdl-include-group-comments 'always) |
| 3723 | :style radio :selected (eq 'always vhdl-include-group-comments)]) |
| 3724 | ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] |
| 3725 | ["Instance Name..." (customize-option 'vhdl-instance-name) t] |
| 3726 | ("Testbench" |
| 3727 | ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] |
| 3728 | ["Architecture Name..." |
| 3729 | (customize-option 'vhdl-testbench-architecture-name) t] |
| 3730 | ["Configuration Name..." |
| 3731 | (customize-option 'vhdl-testbench-configuration-name) t] |
| 3732 | ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] |
| 3733 | ["Include Header" |
| 3734 | (customize-set-variable 'vhdl-testbench-include-header |
| 3735 | (not vhdl-testbench-include-header)) |
| 3736 | :style toggle :selected vhdl-testbench-include-header] |
| 3737 | ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] |
| 3738 | ["Statements..." (customize-option 'vhdl-testbench-statements) t] |
| 3739 | ["Initialize Signals" |
| 3740 | (customize-set-variable 'vhdl-testbench-initialize-signals |
| 3741 | (not vhdl-testbench-initialize-signals)) |
| 3742 | :style toggle :selected vhdl-testbench-initialize-signals] |
| 3743 | ["Include Library Clause" |
| 3744 | (customize-set-variable 'vhdl-testbench-include-library |
| 3745 | (not vhdl-testbench-include-library)) |
| 3746 | :style toggle :selected vhdl-testbench-include-library] |
| 3747 | ["Include Configuration" |
| 3748 | (customize-set-variable 'vhdl-testbench-include-configuration |
| 3749 | (not vhdl-testbench-include-configuration)) |
| 3750 | :style toggle :selected vhdl-testbench-include-configuration] |
| 3751 | ("Create Files" |
| 3752 | ["None" |
| 3753 | (customize-set-variable 'vhdl-testbench-create-files 'none) |
| 3754 | :style radio :selected (eq 'none vhdl-testbench-create-files)] |
| 3755 | ["Single" |
| 3756 | (customize-set-variable 'vhdl-testbench-create-files 'single) |
| 3757 | :style radio :selected (eq 'single vhdl-testbench-create-files)] |
| 3758 | ["Separate" |
| 3759 | (customize-set-variable 'vhdl-testbench-create-files 'separate) |
| 3760 | :style radio :selected (eq 'separate vhdl-testbench-create-files)]) |
| 3761 | ["Testbench Entity File Name..." |
| 3762 | (customize-option 'vhdl-testbench-entity-file-name) t] |
| 3763 | ["Testbench Architecture File Name..." |
| 3764 | (customize-option 'vhdl-testbench-architecture-file-name) t]) |
| 3765 | "--" |
| 3766 | ["Customize Group..." (customize-group 'vhdl-port) t]) |
| 3767 | ("Compose" |
| 3768 | ["Architecture Name..." |
| 3769 | (customize-option 'vhdl-compose-architecture-name) t] |
| 3770 | ["Configuration Name..." |
| 3771 | (customize-option 'vhdl-compose-configuration-name) t] |
| 3772 | ["Components Package Name..." |
| 3773 | (customize-option 'vhdl-components-package-name) t] |
| 3774 | ["Use Components Package" |
| 3775 | (customize-set-variable 'vhdl-use-components-package |
| 3776 | (not vhdl-use-components-package)) |
| 3777 | :style toggle :selected vhdl-use-components-package] |
| 3778 | ["Include Header" |
| 3779 | (customize-set-variable 'vhdl-compose-include-header |
| 3780 | (not vhdl-compose-include-header)) |
| 3781 | :style toggle :selected vhdl-compose-include-header] |
| 3782 | ("Create Entity/Architecture Files" |
| 3783 | ["None" |
| 3784 | (customize-set-variable 'vhdl-compose-create-files 'none) |
| 3785 | :style radio :selected (eq 'none vhdl-compose-create-files)] |
| 3786 | ["Single" |
| 3787 | (customize-set-variable 'vhdl-compose-create-files 'single) |
| 3788 | :style radio :selected (eq 'single vhdl-compose-create-files)] |
| 3789 | ["Separate" |
| 3790 | (customize-set-variable 'vhdl-compose-create-files 'separate) |
| 3791 | :style radio :selected (eq 'separate vhdl-compose-create-files)]) |
| 3792 | ["Create Configuration File" |
| 3793 | (customize-set-variable 'vhdl-compose-configuration-create-file |
| 3794 | (not vhdl-compose-configuration-create-file)) |
| 3795 | :style toggle :selected vhdl-compose-configuration-create-file] |
| 3796 | ["Hierarchical Configuration" |
| 3797 | (customize-set-variable 'vhdl-compose-configuration-hierarchical |
| 3798 | (not vhdl-compose-configuration-hierarchical)) |
| 3799 | :style toggle :selected vhdl-compose-configuration-hierarchical] |
| 3800 | ["Use Subconfiguration" |
| 3801 | (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration |
| 3802 | (not vhdl-compose-configuration-use-subconfiguration)) |
| 3803 | :style toggle :selected vhdl-compose-configuration-use-subconfiguration] |
| 3804 | "--" |
| 3805 | ["Customize Group..." (customize-group 'vhdl-compose) t]) |
| 3806 | ("Comment" |
| 3807 | ["Self Insert Comments" |
| 3808 | (customize-set-variable 'vhdl-self-insert-comments |
| 3809 | (not vhdl-self-insert-comments)) |
| 3810 | :style toggle :selected vhdl-self-insert-comments] |
| 3811 | ["Prompt for Comments" |
| 3812 | (customize-set-variable 'vhdl-prompt-for-comments |
| 3813 | (not vhdl-prompt-for-comments)) |
| 3814 | :style toggle :selected vhdl-prompt-for-comments] |
| 3815 | ["Inline Comment Column..." |
| 3816 | (customize-option 'vhdl-inline-comment-column) t] |
| 3817 | ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] |
| 3818 | "--" |
| 3819 | ["Customize Group..." (customize-group 'vhdl-comment) t]) |
| 3820 | ("Align" |
| 3821 | ["Auto Align Templates" |
| 3822 | (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) |
| 3823 | :style toggle :selected vhdl-auto-align] |
| 3824 | ["Align Line Groups" |
| 3825 | (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) |
| 3826 | :style toggle :selected vhdl-align-groups] |
| 3827 | ["Group Separation String..." |
| 3828 | (customize-set-variable 'vhdl-align-group-separate) t] |
| 3829 | ["Align Lines with Same Indent" |
| 3830 | (customize-set-variable 'vhdl-align-same-indent |
| 3831 | (not vhdl-align-same-indent)) |
| 3832 | :style toggle :selected vhdl-align-same-indent] |
| 3833 | "--" |
| 3834 | ["Customize Group..." (customize-group 'vhdl-align) t]) |
| 3835 | ("Highlight" |
| 3836 | ["Highlighting On/Off..." |
| 3837 | (customize-option |
| 3838 | (if (fboundp 'global-font-lock-mode) |
| 3839 | 'global-font-lock-mode 'font-lock-auto-fontify)) t] |
| 3840 | ["Highlight Keywords" |
| 3841 | (progn (customize-set-variable 'vhdl-highlight-keywords |
| 3842 | (not vhdl-highlight-keywords)) |
| 3843 | (vhdl-fontify-buffer)) |
| 3844 | :style toggle :selected vhdl-highlight-keywords] |
| 3845 | ["Highlight Names" |
| 3846 | (progn (customize-set-variable 'vhdl-highlight-names |
| 3847 | (not vhdl-highlight-names)) |
| 3848 | (vhdl-fontify-buffer)) |
| 3849 | :style toggle :selected vhdl-highlight-names] |
| 3850 | ["Highlight Special Words" |
| 3851 | (progn (customize-set-variable 'vhdl-highlight-special-words |
| 3852 | (not vhdl-highlight-special-words)) |
| 3853 | (vhdl-fontify-buffer)) |
| 3854 | :style toggle :selected vhdl-highlight-special-words] |
| 3855 | ["Highlight Forbidden Words" |
| 3856 | (progn (customize-set-variable 'vhdl-highlight-forbidden-words |
| 3857 | (not vhdl-highlight-forbidden-words)) |
| 3858 | (vhdl-fontify-buffer)) |
| 3859 | :style toggle :selected vhdl-highlight-forbidden-words] |
| 3860 | ["Highlight Verilog Keywords" |
| 3861 | (progn (customize-set-variable 'vhdl-highlight-verilog-keywords |
| 3862 | (not vhdl-highlight-verilog-keywords)) |
| 3863 | (vhdl-fontify-buffer)) |
| 3864 | :style toggle :selected vhdl-highlight-verilog-keywords] |
| 3865 | ["Highlight \"translate_off\"" |
| 3866 | (progn (customize-set-variable 'vhdl-highlight-translate-off |
| 3867 | (not vhdl-highlight-translate-off)) |
| 3868 | (vhdl-fontify-buffer)) |
| 3869 | :style toggle :selected vhdl-highlight-translate-off] |
| 3870 | ["Case Sensitive Highlighting" |
| 3871 | (progn (customize-set-variable 'vhdl-highlight-case-sensitive |
| 3872 | (not vhdl-highlight-case-sensitive)) |
| 3873 | (vhdl-fontify-buffer)) |
| 3874 | :style toggle :selected vhdl-highlight-case-sensitive] |
| 3875 | ["Special Syntax Definition..." |
| 3876 | (customize-option 'vhdl-special-syntax-alist) t] |
| 3877 | ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] |
| 3878 | ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] |
| 3879 | ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] |
| 3880 | ["Colors..." (customize-group 'vhdl-highlight-faces) t] |
| 3881 | "--" |
| 3882 | ["Customize Group..." (customize-group 'vhdl-highlight) t]) |
| 3883 | ("Speedbar" |
| 3884 | ["Auto Open at Startup" |
| 3885 | (customize-set-variable 'vhdl-speedbar-auto-open |
| 3886 | (not vhdl-speedbar-auto-open)) |
| 3887 | :style toggle :selected vhdl-speedbar-auto-open] |
| 3888 | ("Default Displaying Mode" |
| 3889 | ["Files" |
| 3890 | (customize-set-variable 'vhdl-speedbar-display-mode 'files) |
| 3891 | :style radio :selected (eq 'files vhdl-speedbar-display-mode)] |
| 3892 | ["Directory Hierarchy" |
| 3893 | (customize-set-variable 'vhdl-speedbar-display-mode 'directory) |
| 3894 | :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] |
| 3895 | ["Project Hierarchy" |
| 3896 | (customize-set-variable 'vhdl-speedbar-display-mode 'project) |
| 3897 | :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) |
| 3898 | ["Indentation Offset..." |
| 3899 | (customize-option 'speedbar-indentation-width) t] |
| 3900 | ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] |
| 3901 | ["Jump to Unit when Opening" |
| 3902 | (customize-set-variable 'vhdl-speedbar-jump-to-unit |
| 3903 | (not vhdl-speedbar-jump-to-unit)) |
| 3904 | :style toggle :selected vhdl-speedbar-jump-to-unit] |
| 3905 | ["Update Hierarchy on File Saving" |
| 3906 | (customize-set-variable 'vhdl-speedbar-update-on-saving |
| 3907 | (not vhdl-speedbar-update-on-saving)) |
| 3908 | :style toggle :selected vhdl-speedbar-update-on-saving] |
| 3909 | ("Save in Cache File" |
| 3910 | ["Hierarchy Information" |
| 3911 | (customize-set-variable 'vhdl-speedbar-save-cache |
| 3912 | (if (memq 'hierarchy vhdl-speedbar-save-cache) |
| 3913 | (delq 'hierarchy vhdl-speedbar-save-cache) |
| 3914 | (cons 'hierarchy vhdl-speedbar-save-cache))) |
| 3915 | :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] |
| 3916 | ["Displaying Status" |
| 3917 | (customize-set-variable 'vhdl-speedbar-save-cache |
| 3918 | (if (memq 'display vhdl-speedbar-save-cache) |
| 3919 | (delq 'display vhdl-speedbar-save-cache) |
| 3920 | (cons 'display vhdl-speedbar-save-cache))) |
| 3921 | :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) |
| 3922 | ["Cache File Name..." |
| 3923 | (customize-option 'vhdl-speedbar-cache-file-name) t] |
| 3924 | "--" |
| 3925 | ["Customize Group..." (customize-group 'vhdl-speedbar) t]) |
| 3926 | ("Menu" |
| 3927 | ["Add Index Menu when Loading File" |
| 3928 | (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) |
| 3929 | (vhdl-index-menu-init)) |
| 3930 | :style toggle :selected vhdl-index-menu] |
| 3931 | ["Add Source File Menu when Loading File" |
| 3932 | (progn (customize-set-variable 'vhdl-source-file-menu |
| 3933 | (not vhdl-source-file-menu)) |
| 3934 | (vhdl-add-source-files-menu)) |
| 3935 | :style toggle :selected vhdl-source-file-menu] |
| 3936 | ["Add Hideshow Menu at Startup" |
| 3937 | (progn (customize-set-variable 'vhdl-hideshow-menu |
| 3938 | (not vhdl-hideshow-menu)) |
| 3939 | (vhdl-activate-customizations)) |
| 3940 | :style toggle :selected vhdl-hideshow-menu] |
| 3941 | ["Hide Everything Initially" |
| 3942 | (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) |
| 3943 | :style toggle :selected vhdl-hide-all-init] |
| 3944 | "--" |
| 3945 | ["Customize Group..." (customize-group 'vhdl-menu) t]) |
| 3946 | ("Print" |
| 3947 | ["In Two Column Format" |
| 3948 | (progn (customize-set-variable 'vhdl-print-two-column |
| 3949 | (not vhdl-print-two-column)) |
| 3950 | (message "Activate new setting by saving options and restarting Emacs")) |
| 3951 | :style toggle :selected vhdl-print-two-column] |
| 3952 | ["Use Customized Faces" |
| 3953 | (progn (customize-set-variable 'vhdl-print-customize-faces |
| 3954 | (not vhdl-print-customize-faces)) |
| 3955 | (message "Activate new setting by saving options and restarting Emacs")) |
| 3956 | :style toggle :selected vhdl-print-customize-faces] |
| 3957 | "--" |
| 3958 | ["Customize Group..." (customize-group 'vhdl-print) t]) |
| 3959 | ("Miscellaneous" |
| 3960 | ["Use Intelligent Tab" |
| 3961 | (progn (customize-set-variable 'vhdl-intelligent-tab |
| 3962 | (not vhdl-intelligent-tab)) |
| 3963 | (vhdl-activate-customizations)) |
| 3964 | :style toggle :selected vhdl-intelligent-tab] |
| 3965 | ["Indent Syntax-Based" |
| 3966 | (customize-set-variable 'vhdl-indent-syntax-based |
| 3967 | (not vhdl-indent-syntax-based)) |
| 3968 | :style toggle :selected vhdl-indent-syntax-based] |
| 3969 | ["Word Completion is Case Sensitive" |
| 3970 | (customize-set-variable 'vhdl-word-completion-case-sensitive |
| 3971 | (not vhdl-word-completion-case-sensitive)) |
| 3972 | :style toggle :selected vhdl-word-completion-case-sensitive] |
| 3973 | ["Word Completion in Minibuffer" |
| 3974 | (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer |
| 3975 | (not vhdl-word-completion-in-minibuffer)) |
| 3976 | (message "Activate new setting by saving options and restarting Emacs")) |
| 3977 | :style toggle :selected vhdl-word-completion-in-minibuffer] |
| 3978 | ["Underscore is Part of Word" |
| 3979 | (progn (customize-set-variable 'vhdl-underscore-is-part-of-word |
| 3980 | (not vhdl-underscore-is-part-of-word)) |
| 3981 | (vhdl-activate-customizations)) |
| 3982 | :style toggle :selected vhdl-underscore-is-part-of-word] |
| 3983 | "--" |
| 3984 | ["Customize Group..." (customize-group 'vhdl-misc) t]) |
| 3985 | ["Related..." (customize-browse 'vhdl-related) t] |
| 3986 | "--" |
| 3987 | ["Save Options" customize-save-customized t] |
| 3988 | ["Activate Options" vhdl-activate-customizations t] |
| 3989 | ["Browse Options..." vhdl-customize t]))) |
| 3990 | |
| 3991 | (defvar vhdl-mode-menu-list (vhdl-create-mode-menu) |
| 3992 | "VHDL Mode menu.") |
| 3993 | |
| 3994 | (defun vhdl-update-mode-menu () |
| 3995 | "Update VHDL Mode menu." |
| 3996 | (interactive) |
| 3997 | (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs |
| 3998 | (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) |
| 3999 | (easy-menu-add vhdl-mode-menu-list) ; for XEmacs |
| 4000 | (easy-menu-define vhdl-mode-menu vhdl-mode-map |
| 4001 | "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) |
| 4002 | |
| 4003 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4004 | ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') |
| 4005 | |
| 4006 | (defconst vhdl-imenu-generic-expression |
| 4007 | '( |
| 4008 | ("Subprogram" |
| 4009 | "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" |
| 4010 | 4) |
| 4011 | ("Instance" |
| 4012 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" |
| 4013 | 1) |
| 4014 | ("Component" |
| 4015 | "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4016 | 2) |
| 4017 | ("Procedural" |
| 4018 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" |
| 4019 | 1) |
| 4020 | ("Process" |
| 4021 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" |
| 4022 | 1) |
| 4023 | ("Block" |
| 4024 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" |
| 4025 | 1) |
| 4026 | ("Package" |
| 4027 | "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4028 | 3) |
| 4029 | ("Configuration" |
| 4030 | "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" |
| 4031 | 2) |
| 4032 | ("Architecture" |
| 4033 | "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" |
| 4034 | 2) |
| 4035 | ("Entity" |
| 4036 | "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4037 | 2) |
| 4038 | ) |
| 4039 | "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") |
| 4040 | |
| 4041 | (defun vhdl-index-menu-init () |
| 4042 | "Initialize index menu." |
| 4043 | (set (make-local-variable 'imenu-case-fold-search) t) |
| 4044 | (set (make-local-variable 'imenu-generic-expression) |
| 4045 | vhdl-imenu-generic-expression) |
| 4046 | (when (and vhdl-index-menu (fboundp 'imenu)) |
| 4047 | (if (or (not (boundp 'font-lock-maximum-size)) |
| 4048 | (> font-lock-maximum-size (buffer-size))) |
| 4049 | (imenu-add-to-menubar "Index") |
| 4050 | (message "Scanning buffer for index...buffer too big")))) |
| 4051 | |
| 4052 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4053 | ;; Source file menu (using `easy-menu.el') |
| 4054 | |
| 4055 | (defvar vhdl-sources-menu nil) |
| 4056 | |
| 4057 | (defun vhdl-directory-files (directory &optional full match) |
| 4058 | "Call `directory-files' if DIRECTORY exists, otherwise generate error |
| 4059 | message." |
| 4060 | (if (not (file-directory-p directory)) |
| 4061 | (vhdl-warning-when-idle "No such directory: \"%s\"" directory) |
| 4062 | (let ((dir (directory-files directory full match))) |
| 4063 | (setq dir (delete "." dir)) |
| 4064 | (setq dir (delete ".." dir)) |
| 4065 | dir))) |
| 4066 | |
| 4067 | (defun vhdl-get-source-files (&optional full directory) |
| 4068 | "Get list of VHDL source files in DIRECTORY or current directory." |
| 4069 | (let ((mode-alist auto-mode-alist) |
| 4070 | filename-regexp) |
| 4071 | ;; create regular expressions for matching file names |
| 4072 | (setq filename-regexp "\\`[^.].*\\(") |
| 4073 | (while mode-alist |
| 4074 | (when (eq (cdar mode-alist) 'vhdl-mode) |
| 4075 | (setq filename-regexp |
| 4076 | (concat filename-regexp (caar mode-alist) "\\|"))) |
| 4077 | (setq mode-alist (cdr mode-alist))) |
| 4078 | (setq filename-regexp |
| 4079 | (concat (substring filename-regexp 0 |
| 4080 | (string-match "\\\\|$" filename-regexp)) "\\)")) |
| 4081 | ;; find files |
| 4082 | (vhdl-directory-files |
| 4083 | (or directory default-directory) full filename-regexp))) |
| 4084 | |
| 4085 | (defun vhdl-add-source-files-menu () |
| 4086 | "Scan directory for all VHDL source files and generate menu. |
| 4087 | The directory of the current source file is scanned." |
| 4088 | (interactive) |
| 4089 | (message "Scanning directory for source files ...") |
| 4090 | (let ((newmap (current-local-map)) |
| 4091 | (file-list (vhdl-get-source-files)) |
| 4092 | menu-list found) |
| 4093 | ;; Create list for menu |
| 4094 | (setq found nil) |
| 4095 | (while file-list |
| 4096 | (setq found t) |
| 4097 | (setq menu-list (cons (vector (car file-list) |
| 4098 | (list 'find-file (car file-list)) t) |
| 4099 | menu-list)) |
| 4100 | (setq file-list (cdr file-list))) |
| 4101 | (setq menu-list (vhdl-menu-split menu-list "Sources")) |
| 4102 | (when found (setq menu-list (cons "--" menu-list))) |
| 4103 | (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list)) |
| 4104 | (setq menu-list (cons "Sources" menu-list)) |
| 4105 | ;; Create menu |
| 4106 | (easy-menu-add menu-list) |
| 4107 | (easy-menu-define vhdl-sources-menu newmap |
| 4108 | "VHDL source files menu" menu-list)) |
| 4109 | (message "")) |
| 4110 | |
| 4111 | |
| 4112 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4113 | ;;; Mode definition |
| 4114 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4115 | ;; performs all buffer local initializations |
| 4116 | |
| 4117 | ;;;###autoload |
| 4118 | (define-derived-mode vhdl-mode prog-mode |
| 4119 | '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) |
| 4120 | (vhdl-electric-mode "e") |
| 4121 | (vhdl-stutter-mode "s")) |
| 4122 | "Major mode for editing VHDL code. |
| 4123 | |
| 4124 | Usage: |
| 4125 | ------ |
| 4126 | |
| 4127 | TEMPLATE INSERTION (electrification): |
| 4128 | After typing a VHDL keyword and entering `SPC', you are prompted for |
| 4129 | arguments while a template is generated for that VHDL construct. Typing |
| 4130 | `RET' or `C-g' at the first \(mandatory) prompt aborts the current |
| 4131 | template generation. Optional arguments are indicated by square |
| 4132 | brackets and removed if the queried string is left empty. Prompts for |
| 4133 | mandatory arguments remain in the code if the queried string is left |
| 4134 | empty. They can be queried again by `C-c C-t C-q'. Enabled |
| 4135 | electrification is indicated by `/e' in the modeline. |
| 4136 | |
| 4137 | Typing `M-SPC' after a keyword inserts a space without calling the |
| 4138 | template generator. Automatic template generation (i.e. |
| 4139 | electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by |
| 4140 | setting option `vhdl-electric-mode' (see OPTIONS). |
| 4141 | |
| 4142 | Template generators can be invoked from the VHDL menu, by key |
| 4143 | bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing |
| 4144 | the keyword (i.e. first word of menu entry not in parenthesis) and |
| 4145 | `SPC'. The following abbreviations can also be used: arch, attr, cond, |
| 4146 | conf, comp, cons, func, inst, pack, sig, var. |
| 4147 | |
| 4148 | Template styles can be customized in customization group |
| 4149 | `vhdl-template' \(see OPTIONS). |
| 4150 | |
| 4151 | |
| 4152 | HEADER INSERTION: |
| 4153 | A file header can be inserted by `C-c C-t C-h'. A file footer |
| 4154 | (template at the end of the file) can be inserted by `C-c C-t C-f'. |
| 4155 | See customization group `vhdl-header'. |
| 4156 | |
| 4157 | |
| 4158 | STUTTERING: |
| 4159 | Double striking of some keys inserts cumbersome VHDL syntax elements. |
| 4160 | Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by |
| 4161 | option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in |
| 4162 | the modeline. The stuttering keys and their effects are: |
| 4163 | |
| 4164 | ;; --> \" : \" [ --> ( -- --> comment |
| 4165 | ;;; --> \" := \" [[ --> [ --CR --> comment-out code |
| 4166 | .. --> \" => \" ] --> ) --- --> horizontal line |
| 4167 | ,, --> \" <= \" ]] --> ] ---- --> display comment |
| 4168 | == --> \" == \" '' --> \\\" |
| 4169 | |
| 4170 | |
| 4171 | WORD COMPLETION: |
| 4172 | Typing `TAB' after a (not completed) word looks for a VHDL keyword or a |
| 4173 | word in the buffer that starts alike, inserts it and adjusts case. |
| 4174 | Re-typing `TAB' toggles through alternative word completions. This also |
| 4175 | works in the minibuffer (i.e. in template generator prompts). |
| 4176 | |
| 4177 | Typing `TAB' after `(' looks for and inserts complete parenthesized |
| 4178 | expressions (e.g. for array index ranges). All keywords as well as |
| 4179 | standard types and subprograms of VHDL have predefined abbreviations |
| 4180 | \(e.g. type \"std\" and `TAB' will toggle through all standard types |
| 4181 | beginning with \"std\"). |
| 4182 | |
| 4183 | Typing `TAB' after a non-word character indents the line if at the |
| 4184 | beginning of a line (i.e. no preceding non-blank characters), and |
| 4185 | inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator |
| 4186 | stop. |
| 4187 | |
| 4188 | |
| 4189 | COMMENTS: |
| 4190 | `--' puts a single comment. |
| 4191 | `---' draws a horizontal line for separating code segments. |
| 4192 | `----' inserts a display comment, i.e. two horizontal lines |
| 4193 | with a comment in between. |
| 4194 | `--CR' comments out code on that line. Re-hitting CR comments |
| 4195 | out following lines. |
| 4196 | `C-c c' comments out a region if not commented out, |
| 4197 | uncomments a region if already commented out. |
| 4198 | |
| 4199 | You are prompted for comments after object definitions (i.e. signals, |
| 4200 | variables, constants, ports) and after subprogram and process |
| 4201 | specifications if option `vhdl-prompt-for-comments' is non-nil. |
| 4202 | Comments are automatically inserted as additional labels (e.g. after |
| 4203 | begin statements) and as help comments if `vhdl-self-insert-comments' is |
| 4204 | non-nil. |
| 4205 | |
| 4206 | Inline comments (i.e. comments after a piece of code on the same line) |
| 4207 | are indented at least to `vhdl-inline-comment-column'. Comments go at |
| 4208 | maximum to `vhdl-end-comment-column'. `RET' after a space in a comment |
| 4209 | will open a new comment line. Typing beyond `vhdl-end-comment-column' |
| 4210 | in a comment automatically opens a new comment line. `M-q' re-fills |
| 4211 | multi-line comments. |
| 4212 | |
| 4213 | |
| 4214 | INDENTATION: |
| 4215 | `TAB' indents a line if at the beginning of the line. The amount of |
| 4216 | indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' |
| 4217 | always indents the current line (is bound to `TAB' if option |
| 4218 | `vhdl-intelligent-tab' is nil). |
| 4219 | |
| 4220 | Indentation can be done for a group of lines (`C-c C-i C-g'), a region |
| 4221 | \(`M-C-\\') or the entire buffer (menu). Argument and port lists are |
| 4222 | indented normally (nil) or relative to the opening parenthesis (non-nil) |
| 4223 | according to option `vhdl-argument-list-indent'. |
| 4224 | |
| 4225 | If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of |
| 4226 | tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs |
| 4227 | and vice versa. |
| 4228 | |
| 4229 | Syntax-based indentation can be very slow in large files. Option |
| 4230 | `vhdl-indent-syntax-based' allows to use faster but simpler indentation. |
| 4231 | |
| 4232 | |
| 4233 | ALIGNMENT: |
| 4234 | The alignment functions align operators, keywords, and inline comments |
| 4235 | to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines |
| 4236 | separated by blank lines, `C-c C-a C-i' a block of lines with same |
| 4237 | indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by |
| 4238 | a pair of parentheses (e.g. port clause/map, argument list), and `C-c |
| 4239 | C-a C-d' all lines within the declarative part of a design unit. `C-c |
| 4240 | C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments |
| 4241 | for a group of lines, and `C-c C-a M-c' for a region. |
| 4242 | |
| 4243 | If option `vhdl-align-groups' is non-nil, groups of code lines |
| 4244 | separated by special lines (see option `vhdl-align-group-separate') are |
| 4245 | aligned individually. If option `vhdl-align-same-indent' is non-nil, |
| 4246 | blocks of lines with same indent are aligned separately. Some templates |
| 4247 | are automatically aligned after generation if option `vhdl-auto-align' |
| 4248 | is non-nil. |
| 4249 | |
| 4250 | Alignment tries to align inline comments at |
| 4251 | `vhdl-inline-comment-column' and tries inline comment not to exceed |
| 4252 | `vhdl-end-comment-column'. |
| 4253 | |
| 4254 | `C-c C-x M-w' fixes up whitespace in a region. That is, operator |
| 4255 | symbols are surrounded by one space, and multiple spaces are eliminated. |
| 4256 | |
| 4257 | |
| 4258 | CODE FILLING: |
| 4259 | Code filling allows to condense code (e.g. sensitivity lists or port |
| 4260 | maps) by removing comments and newlines and re-wrapping so that all |
| 4261 | lines are maximally filled (block filling). `C-c C-f C-f' fills a list |
| 4262 | enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by |
| 4263 | blank lines, `C-c C-f C-i' a block of lines with same indent, and |
| 4264 | `C-c C-f M-f' an entire region. |
| 4265 | |
| 4266 | |
| 4267 | CODE BEAUTIFICATION: |
| 4268 | `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire |
| 4269 | buffer respectively. This includes indentation, alignment, and case |
| 4270 | fixing. Code beautification can also be run non-interactively using the |
| 4271 | command: |
| 4272 | |
| 4273 | emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer |
| 4274 | |
| 4275 | |
| 4276 | PORT TRANSLATION: |
| 4277 | Generic and port clauses from entity or component declarations can be |
| 4278 | copied (`C-c C-p C-w') and pasted as entity and component declarations, |
| 4279 | as component instantiations and corresponding internal constants and |
| 4280 | signals, as a generic map with constants as actual generics, and as |
| 4281 | internal signal initializations (menu). |
| 4282 | |
| 4283 | To include formals in component instantiations, see option |
| 4284 | `vhdl-association-list-with-formals'. To include comments in pasting, |
| 4285 | see options `vhdl-include-...-comments'. |
| 4286 | |
| 4287 | A clause with several generic/port names on the same line can be |
| 4288 | flattened (`C-c C-p C-f') so that only one name per line exists. The |
| 4289 | direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become |
| 4290 | outputs and vice versa, which can be useful in testbenches. (This |
| 4291 | reversion is done on the internal data structure and is only reflected |
| 4292 | in subsequent paste operations.) |
| 4293 | |
| 4294 | Names for actual ports, instances, testbenches, and |
| 4295 | design-under-test instances can be derived from existing names according |
| 4296 | to options `vhdl-...-name'. See customization group `vhdl-port'. |
| 4297 | |
| 4298 | |
| 4299 | SUBPROGRAM TRANSLATION: |
| 4300 | Similar functionality exists for copying/pasting the interface of |
| 4301 | subprograms (function/procedure). A subprogram interface can be copied |
| 4302 | and then pasted as a subprogram declaration, body or call (uses |
| 4303 | association list with formals). |
| 4304 | |
| 4305 | |
| 4306 | TESTBENCH GENERATION: |
| 4307 | A copied port can also be pasted as a testbench. The generated |
| 4308 | testbench includes an entity, an architecture, and an optional |
| 4309 | configuration. The architecture contains the component declaration and |
| 4310 | instantiation of the DUT as well as internal constant and signal |
| 4311 | declarations. Additional user-defined templates can be inserted. The |
| 4312 | names used for entity/architecture/configuration/DUT as well as the file |
| 4313 | structure to be generated can be customized. See customization group |
| 4314 | `vhdl-testbench'. |
| 4315 | |
| 4316 | |
| 4317 | KEY BINDINGS: |
| 4318 | Key bindings (`C-c ...') exist for most commands (see in menu). |
| 4319 | |
| 4320 | |
| 4321 | VHDL MENU: |
| 4322 | All commands can be found in the VHDL menu including their key bindings. |
| 4323 | |
| 4324 | |
| 4325 | FILE BROWSER: |
| 4326 | The speedbar allows browsing of directories and file contents. It can |
| 4327 | be accessed from the VHDL menu and is automatically opened if option |
| 4328 | `vhdl-speedbar-auto-open' is non-nil. |
| 4329 | |
| 4330 | In speedbar, open files and directories with `mouse-2' on the name and |
| 4331 | browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. |
| 4332 | |
| 4333 | |
| 4334 | DESIGN HIERARCHY BROWSER: |
| 4335 | The speedbar can also be used for browsing the hierarchy of design units |
| 4336 | contained in the source files of the current directory or the specified |
| 4337 | projects (see option `vhdl-project-alist'). |
| 4338 | |
| 4339 | The speedbar can be switched between file, directory hierarchy and |
| 4340 | project hierarchy browsing mode in the speedbar menu or by typing `f', |
| 4341 | `h' or `H' in speedbar. |
| 4342 | |
| 4343 | In speedbar, open design units with `mouse-2' on the name and browse |
| 4344 | their hierarchy with `mouse-2' on the `+'. Ports can directly be copied |
| 4345 | from entities and components (in packages). Individual design units and |
| 4346 | complete designs can directly be compiled (\"Make\" menu entry). |
| 4347 | |
| 4348 | The hierarchy is automatically updated upon saving a modified source |
| 4349 | file when option `vhdl-speedbar-update-on-saving' is non-nil. The |
| 4350 | hierarchy is only updated for projects that have been opened once in the |
| 4351 | speedbar. The hierarchy is cached between Emacs sessions in a file (see |
| 4352 | options in group `vhdl-speedbar'). |
| 4353 | |
| 4354 | Simple design consistency checks are done during scanning, such as |
| 4355 | multiple declarations of the same unit or missing primary units that are |
| 4356 | required by secondary units. |
| 4357 | |
| 4358 | |
| 4359 | STRUCTURAL COMPOSITION: |
| 4360 | Enables simple structural composition. `C-c C-c C-n' creates a skeleton |
| 4361 | for a new component. Subcomponents (i.e. component declaration and |
| 4362 | instantiation) can be automatically placed from a previously read port |
| 4363 | \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally, |
| 4364 | all subcomponents can be automatically connected using internal signals |
| 4365 | and ports (`C-c C-c C-w') following these rules: |
| 4366 | - subcomponent actual ports with same name are considered to be |
| 4367 | connected by a signal (internal signal or port) |
| 4368 | - signals that are only inputs to subcomponents are considered as |
| 4369 | inputs to this component -> input port created |
| 4370 | - signals that are only outputs from subcomponents are considered as |
| 4371 | outputs from this component -> output port created |
| 4372 | - signals that are inputs to AND outputs from subcomponents are |
| 4373 | considered as internal connections -> internal signal created |
| 4374 | |
| 4375 | Purpose: With appropriate naming conventions it is possible to |
| 4376 | create higher design levels with only a few mouse clicks or key |
| 4377 | strokes. A new design level can be created by simply generating a new |
| 4378 | component, placing the required subcomponents from the hierarchy |
| 4379 | browser, and wiring everything automatically. |
| 4380 | |
| 4381 | Note: Automatic wiring only works reliably on templates of new |
| 4382 | components and component instantiations that were created by VHDL mode. |
| 4383 | |
| 4384 | Component declarations can be placed in a components package (option |
| 4385 | `vhdl-use-components-package') which can be automatically generated for |
| 4386 | an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct |
| 4387 | component instantiation is also supported (option |
| 4388 | `vhdl-use-direct-instantiation'). |
| 4389 | |
| 4390 | | Configuration declarations can automatically be generated either from |
| 4391 | | the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from |
| 4392 | | the speedbar menu (for the architecture under the cursor). The |
| 4393 | | configurations can optionally be hierarchical (i.e. include all |
| 4394 | | component levels of a hierarchical design, option |
| 4395 | | `vhdl-compose-configuration-hierarchical') or include subconfigurations |
| 4396 | | (option `vhdl-compose-configuration-use-subconfiguration'). For |
| 4397 | | subcomponents in hierarchical configurations, the most-recently-analyzed |
| 4398 | | (mra) architecture is selected. If another architecture is desired, it |
| 4399 | | can be marked as most-recently-analyzed (speedbar menu) before |
| 4400 | | generating the configuration. |
| 4401 | | |
| 4402 | | Note: Configurations of subcomponents (i.e. hierarchical configuration |
| 4403 | | declarations) are currently not considered when displaying |
| 4404 | | configurations in speedbar. |
| 4405 | |
| 4406 | See the options group `vhdl-compose' for all relevant user options. |
| 4407 | |
| 4408 | |
| 4409 | SOURCE FILE COMPILATION: |
| 4410 | The syntax of the current buffer can be analyzed by calling a VHDL |
| 4411 | compiler (menu, `C-c C-k'). The compiler to be used is specified by |
| 4412 | option `vhdl-compiler'. The available compilers are listed in option |
| 4413 | `vhdl-compiler-alist' including all required compilation command, |
| 4414 | command options, compilation directory, and error message syntax |
| 4415 | information. New compilers can be added. |
| 4416 | |
| 4417 | All the source files of an entire design can be compiled by the `make' |
| 4418 | command (menu, `C-c M-C-k') if an appropriate Makefile exists. |
| 4419 | |
| 4420 | |
| 4421 | MAKEFILE GENERATION: |
| 4422 | Makefiles can be generated automatically by an internal generation |
| 4423 | routine (`C-c M-k'). The library unit dependency information is |
| 4424 | obtained from the hierarchy browser. Makefile generation can be |
| 4425 | customized for each compiler in option `vhdl-compiler-alist'. |
| 4426 | |
| 4427 | Makefile generation can also be run non-interactively using the |
| 4428 | command: |
| 4429 | |
| 4430 | emacs -batch -l ~/.emacs -l vhdl-mode |
| 4431 | [-compiler compilername] [-project projectname] |
| 4432 | -f vhdl-generate-makefile |
| 4433 | |
| 4434 | The Makefile's default target \"all\" compiles the entire design, the |
| 4435 | target \"clean\" removes it and the target \"library\" creates the |
| 4436 | library directory if not existent. The Makefile also includes a target |
| 4437 | for each primary library unit which allows selective compilation of this |
| 4438 | unit, its secondary units and its subhierarchy (example: compilation of |
| 4439 | a design specified by a configuration). User specific parts can be |
| 4440 | inserted into a Makefile with option `vhdl-makefile-generation-hook'. |
| 4441 | |
| 4442 | Limitations: |
| 4443 | - Only library units and dependencies within the current library are |
| 4444 | considered. Makefiles for designs that span multiple libraries are |
| 4445 | not (yet) supported. |
| 4446 | - Only one-level configurations are supported (also hierarchical), |
| 4447 | but configurations that go down several levels are not. |
| 4448 | - The \"others\" keyword in configurations is not supported. |
| 4449 | |
| 4450 | |
| 4451 | PROJECTS: |
| 4452 | Projects can be defined in option `vhdl-project-alist' and a current |
| 4453 | project be selected using option `vhdl-project' (permanently) or from |
| 4454 | the menu or speedbar (temporarily). For each project, title and |
| 4455 | description strings (for the file headers), source files/directories |
| 4456 | (for the hierarchy browser and Makefile generation), library name, and |
| 4457 | compiler-dependent options, exceptions and compilation directory can be |
| 4458 | specified. Compilation settings overwrite the settings of option |
| 4459 | `vhdl-compiler-alist'. |
| 4460 | |
| 4461 | Project setups can be exported (i.e. written to a file) and imported. |
| 4462 | Imported setups are not automatically saved in `vhdl-project-alist' but |
| 4463 | can be saved afterwards in its customization buffer. When starting |
| 4464 | Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l |
| 4465 | vhdl-mode\") in a directory with an existing project setup file, it is |
| 4466 | automatically loaded and its project activated if option |
| 4467 | `vhdl-project-auto-load' is non-nil. Names/paths of the project setup |
| 4468 | files can be specified in option `vhdl-project-file-name'. Multiple |
| 4469 | project setups can be automatically loaded from global directories. |
| 4470 | This is an alternative to specifying project setups with option |
| 4471 | `vhdl-project-alist'. |
| 4472 | |
| 4473 | |
| 4474 | SPECIAL MENUES: |
| 4475 | As an alternative to the speedbar, an index menu can be added (set |
| 4476 | option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu |
| 4477 | (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up |
| 4478 | file) for browsing the file contents (is not populated if buffer is |
| 4479 | larger than `font-lock-maximum-size'). Also, a source file menu can be |
| 4480 | added (set option `vhdl-source-file-menu' to non-nil) for browsing the |
| 4481 | current directory for VHDL source files. |
| 4482 | |
| 4483 | |
| 4484 | VHDL STANDARDS: |
| 4485 | The VHDL standards to be used are specified in option `vhdl-standard'. |
| 4486 | Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages. |
| 4487 | |
| 4488 | |
| 4489 | KEYWORD CASE: |
| 4490 | Lower and upper case for keywords and standardized types, attributes, |
| 4491 | and enumeration values is supported. If the option |
| 4492 | `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in |
| 4493 | lower case and are converted into upper case automatically (not for |
| 4494 | types, attributes, and enumeration values). The case of keywords, |
| 4495 | types, attributes,and enumeration values can be fixed for an entire |
| 4496 | region (menu) or buffer (`C-c C-x C-c') according to the options |
| 4497 | `vhdl-upper-case-{keywords,types,attributes,enum-values}'. |
| 4498 | |
| 4499 | |
| 4500 | HIGHLIGHTING (fontification): |
| 4501 | Keywords and standardized types, attributes, enumeration values, and |
| 4502 | function names (controlled by option `vhdl-highlight-keywords'), as well |
| 4503 | as comments, strings, and template prompts are highlighted using |
| 4504 | different colors. Unit, subprogram, signal, variable, constant, |
| 4505 | parameter and generic/port names in declarations as well as labels are |
| 4506 | highlighted if option `vhdl-highlight-names' is non-nil. |
| 4507 | |
| 4508 | Additional reserved words or words with a forbidden syntax (e.g. words |
| 4509 | that should be avoided) can be specified in option |
| 4510 | `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in |
| 4511 | a warning color (option `vhdl-highlight-forbidden-words'). Verilog |
| 4512 | keywords are highlighted as forbidden words if option |
| 4513 | `vhdl-highlight-verilog-keywords' is non-nil. |
| 4514 | |
| 4515 | Words with special syntax can be highlighted by specifying their |
| 4516 | syntax and color in option `vhdl-special-syntax-alist' and by setting |
| 4517 | option `vhdl-highlight-special-words' to non-nil. This allows to |
| 4518 | establish some naming conventions (e.g. to distinguish different kinds |
| 4519 | of signals or other objects by using name suffices) and to support them |
| 4520 | visually. |
| 4521 | |
| 4522 | Option `vhdl-highlight-case-sensitive' can be set to non-nil in order |
| 4523 | to support case-sensitive highlighting. However, keywords are then only |
| 4524 | highlighted if written in lower case. |
| 4525 | |
| 4526 | Code between \"translate_off\" and \"translate_on\" pragmas is |
| 4527 | highlighted using a different background color if option |
| 4528 | `vhdl-highlight-translate-off' is non-nil. |
| 4529 | |
| 4530 | For documentation and customization of the used colors see |
| 4531 | customization group `vhdl-highlight-faces' (`M-x customize-group'). For |
| 4532 | highlighting of matching parenthesis, see customization group |
| 4533 | `paren-showing'. Automatic buffer highlighting is turned on/off by |
| 4534 | option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). |
| 4535 | |
| 4536 | |
| 4537 | USER MODELS: |
| 4538 | VHDL models (templates) can be specified by the user and made accessible |
| 4539 | in the menu, through key bindings (`C-c C-m ...'), or by keyword |
| 4540 | electrification. See option `vhdl-model-alist'. |
| 4541 | |
| 4542 | |
| 4543 | HIDE/SHOW: |
| 4544 | The code of blocks, processes, subprograms, component declarations and |
| 4545 | instantiations, generic/port clauses, and configuration declarations can |
| 4546 | be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within |
| 4547 | the code (see customization group `vhdl-menu'). XEmacs: limited |
| 4548 | functionality due to old `hideshow.el' package. |
| 4549 | |
| 4550 | |
| 4551 | CODE UPDATING: |
| 4552 | - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the |
| 4553 | current process, `C-c C-u M-s' of all processes in the current buffer. |
| 4554 | Limitations: |
| 4555 | - Only declared local signals (ports, signals declared in |
| 4556 | architecture and blocks) are automatically inserted. |
| 4557 | - Global signals declared in packages are not automatically inserted. |
| 4558 | Insert them once manually (will be kept afterwards). |
| 4559 | - Out parameters of procedures are considered to be read. |
| 4560 | Use option `vhdl-entity-file-name' to specify the entity file name |
| 4561 | \(used to obtain the port names). |
| 4562 | |
| 4563 | |
| 4564 | CODE FIXING: |
| 4565 | `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause |
| 4566 | \(e.g. if the closing parenthesis is on the wrong line or is missing). |
| 4567 | |
| 4568 | |
| 4569 | PRINTING: |
| 4570 | PostScript printing with different faces (an optimized set of faces is |
| 4571 | used if `vhdl-print-customize-faces' is non-nil) or colors \(if |
| 4572 | `ps-print-color-p' is non-nil) is possible using the standard Emacs |
| 4573 | PostScript printing commands. Option `vhdl-print-two-column' defines |
| 4574 | appropriate default settings for nice landscape two-column printing. |
| 4575 | The paper format can be set by option `ps-paper-type'. Do not forget to |
| 4576 | switch `ps-print-color-p' to nil for printing on black-and-white |
| 4577 | printers. |
| 4578 | |
| 4579 | |
| 4580 | OPTIONS: |
| 4581 | User options allow customization of VHDL Mode. All options are |
| 4582 | accessible from the \"Options\" menu entry. Simple options (switches |
| 4583 | and choices) can directly be changed, while for complex options a |
| 4584 | customization buffer is opened. Changed options can be saved for future |
| 4585 | sessions using the \"Save Options\" menu entry. |
| 4586 | |
| 4587 | Options and their detailed descriptions can also be accessed by using |
| 4588 | the \"Customize\" menu entry or the command `M-x customize-option' (`M-x |
| 4589 | customize-group' for groups). Some customizations only take effect |
| 4590 | after some action (read the NOTE in the option documentation). |
| 4591 | Customization can also be done globally (i.e. site-wide, read the |
| 4592 | INSTALL file). |
| 4593 | |
| 4594 | Not all options are described in this documentation, so go and see |
| 4595 | what other useful user options there are (`M-x vhdl-customize' or menu)! |
| 4596 | |
| 4597 | |
| 4598 | FILE EXTENSIONS: |
| 4599 | As default, files with extensions \".vhd\" and \".vhdl\" are |
| 4600 | automatically recognized as VHDL source files. To add an extension |
| 4601 | \".xxx\", add the following line to your Emacs start-up file (`.emacs'): |
| 4602 | |
| 4603 | \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) |
| 4604 | |
| 4605 | |
| 4606 | HINTS: |
| 4607 | - To start Emacs with open VHDL hierarchy browser without having to load |
| 4608 | a VHDL file first, use the command: |
| 4609 | |
| 4610 | emacs -l vhdl-mode -f speedbar-frame-mode |
| 4611 | |
| 4612 | - Type `C-g C-g' to interrupt long operations or if Emacs hangs. |
| 4613 | |
| 4614 | - Some features only work on properly indented code. |
| 4615 | |
| 4616 | |
| 4617 | RELEASE NOTES: |
| 4618 | See also the release notes (menu) for added features in new releases. |
| 4619 | |
| 4620 | |
| 4621 | Maintenance: |
| 4622 | ------------ |
| 4623 | |
| 4624 | To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode. |
| 4625 | Add a description of the problem and include a reproducible test case. |
| 4626 | |
| 4627 | Questions and enhancement requests can be sent to <reto@gnu.org>. |
| 4628 | |
| 4629 | The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. |
| 4630 | The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta |
| 4631 | releases. You are kindly invited to participate in beta testing. Subscribe |
| 4632 | to above mailing lists by sending an email to <reto@gnu.org>. |
| 4633 | |
| 4634 | VHDL Mode is officially distributed at |
| 4635 | URL `http://opensource.ethz.ch/emacs/vhdl-mode.html' |
| 4636 | where the latest version can be found. |
| 4637 | |
| 4638 | |
| 4639 | Known problems: |
| 4640 | --------------- |
| 4641 | |
| 4642 | - Indentation bug in simultaneous if- and case-statements (VHDL-AMS). |
| 4643 | - XEmacs: Incorrect start-up when automatically opening speedbar. |
| 4644 | - XEmacs: Indentation in XEmacs 21.4 (and higher). |
| 4645 | |
| 4646 | |
| 4647 | The VHDL Mode Authors |
| 4648 | Reto Zimmermann and Rod Whitby |
| 4649 | |
| 4650 | Key bindings: |
| 4651 | ------------- |
| 4652 | |
| 4653 | \\{vhdl-mode-map}" |
| 4654 | :abbrev-table vhdl-mode-abbrev-table |
| 4655 | |
| 4656 | ;; set local variables |
| 4657 | (set (make-local-variable 'paragraph-start) |
| 4658 | "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)") |
| 4659 | (set (make-local-variable 'paragraph-separate) paragraph-start) |
| 4660 | (set (make-local-variable 'paragraph-ignore-fill-prefix) t) |
| 4661 | (set (make-local-variable 'parse-sexp-ignore-comments) t) |
| 4662 | (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) |
| 4663 | (set (make-local-variable 'comment-start) "--") |
| 4664 | (set (make-local-variable 'comment-end) "") |
| 4665 | (when vhdl-emacs-21 |
| 4666 | (set (make-local-variable 'comment-padding) "")) |
| 4667 | (set (make-local-variable 'comment-column) vhdl-inline-comment-column) |
| 4668 | (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) |
| 4669 | (set (make-local-variable 'comment-start-skip) "--+\\s-*") |
| 4670 | (set (make-local-variable 'comment-multi-line) nil) |
| 4671 | (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) |
| 4672 | (set (make-local-variable 'hippie-expand-verbose) nil) |
| 4673 | |
| 4674 | ;; setup the comment indent variable in a Emacs version portable way |
| 4675 | ;; ignore any byte compiler warnings you might get here |
| 4676 | (when (boundp 'comment-indent-function) |
| 4677 | (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) |
| 4678 | |
| 4679 | ;; initialize font locking |
| 4680 | (set (make-local-variable 'font-lock-defaults) |
| 4681 | (list |
| 4682 | '(nil vhdl-font-lock-keywords) nil |
| 4683 | (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) |
| 4684 | (if (eval-when-compile (fboundp 'syntax-propertize-rules)) |
| 4685 | (set (make-local-variable 'syntax-propertize-function) |
| 4686 | (syntax-propertize-rules |
| 4687 | ;; Mark single quotes as having string quote syntax in |
| 4688 | ;; 'c' instances. |
| 4689 | ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'")))) |
| 4690 | (set (make-local-variable 'font-lock-syntactic-keywords) |
| 4691 | vhdl-font-lock-syntactic-keywords)) |
| 4692 | (unless vhdl-emacs-21 |
| 4693 | (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) |
| 4694 | (set (make-local-variable 'lazy-lock-defer-contextually) nil) |
| 4695 | (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) |
| 4696 | ; (set (make-local-variable 'lazy-lock-defer-time) 0.1) |
| 4697 | (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) |
| 4698 | ; (turn-on-font-lock) |
| 4699 | |
| 4700 | ;; variables for source file compilation |
| 4701 | (when vhdl-compile-use-local-error-regexp |
| 4702 | (set (make-local-variable 'compilation-error-regexp-alist) nil) |
| 4703 | (set (make-local-variable 'compilation-file-regexp-alist) nil)) |
| 4704 | |
| 4705 | ;; add index menu |
| 4706 | (vhdl-index-menu-init) |
| 4707 | ;; add source file menu |
| 4708 | (if vhdl-source-file-menu (vhdl-add-source-files-menu)) |
| 4709 | ;; add VHDL menu |
| 4710 | (easy-menu-add vhdl-mode-menu-list) ; for XEmacs |
| 4711 | (easy-menu-define vhdl-mode-menu vhdl-mode-map |
| 4712 | "Menu keymap for VHDL Mode." vhdl-mode-menu-list) |
| 4713 | ;; initialize hideshow and add menu |
| 4714 | (vhdl-hideshow-init) |
| 4715 | (run-hooks 'menu-bar-update-hook) |
| 4716 | |
| 4717 | ;; miscellaneous |
| 4718 | (vhdl-ps-print-init) |
| 4719 | (vhdl-write-file-hooks-init) |
| 4720 | (message "VHDL Mode %s.%s" vhdl-version |
| 4721 | (if noninteractive "" " See menu for documentation and release notes."))) |
| 4722 | |
| 4723 | (defun vhdl-activate-customizations () |
| 4724 | "Activate all customizations on local variables." |
| 4725 | (interactive) |
| 4726 | (vhdl-mode-map-init) |
| 4727 | (use-local-map vhdl-mode-map) |
| 4728 | (set-syntax-table vhdl-mode-syntax-table) |
| 4729 | (setq comment-column vhdl-inline-comment-column) |
| 4730 | (setq end-comment-column vhdl-end-comment-column) |
| 4731 | (vhdl-write-file-hooks-init) |
| 4732 | (vhdl-update-mode-menu) |
| 4733 | (vhdl-hideshow-init) |
| 4734 | (run-hooks 'menu-bar-update-hook)) |
| 4735 | |
| 4736 | (defun vhdl-write-file-hooks-init () |
| 4737 | "Add/remove hooks when buffer is saved." |
| 4738 | (if vhdl-modify-date-on-saving |
| 4739 | (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t) |
| 4740 | (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t)) |
| 4741 | (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) |
| 4742 | (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) |
| 4743 | |
| 4744 | (defun vhdl-process-command-line-option (option) |
| 4745 | "Process command line options for VHDL Mode." |
| 4746 | (cond |
| 4747 | ;; set compiler |
| 4748 | ((equal option "-compiler") |
| 4749 | (vhdl-set-compiler (car command-line-args-left)) |
| 4750 | (setq command-line-args-left (cdr command-line-args-left))) |
| 4751 | ;; set project |
| 4752 | ((equal option "-project") |
| 4753 | (vhdl-set-project (car command-line-args-left)) |
| 4754 | (setq command-line-args-left (cdr command-line-args-left))))) |
| 4755 | |
| 4756 | ;; make Emacs process VHDL Mode options |
| 4757 | (setq command-switch-alist |
| 4758 | (append command-switch-alist |
| 4759 | '(("-compiler" . vhdl-process-command-line-option) |
| 4760 | ("-project" . vhdl-process-command-line-option)))) |
| 4761 | |
| 4762 | |
| 4763 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4764 | ;;; Keywords and standardized words |
| 4765 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4766 | |
| 4767 | (defconst vhdl-93-keywords |
| 4768 | '( |
| 4769 | "abs" "access" "after" "alias" "all" "and" "architecture" "array" |
| 4770 | "assert" "attribute" |
| 4771 | "begin" "block" "body" "buffer" "bus" |
| 4772 | "case" "component" "configuration" "constant" |
| 4773 | "disconnect" "downto" |
| 4774 | "else" "elsif" "end" "entity" "exit" |
| 4775 | "file" "for" "function" |
| 4776 | "generate" "generic" "group" "guarded" |
| 4777 | "if" "impure" "in" "inertial" "inout" "is" |
| 4778 | "label" "library" "linkage" "literal" "loop" |
| 4779 | "map" "mod" |
| 4780 | "nand" "new" "next" "nor" "not" "null" |
| 4781 | "of" "on" "open" "or" "others" "out" |
| 4782 | "package" "port" "postponed" "procedure" "process" "pure" |
| 4783 | "range" "record" "register" "reject" "rem" "report" "return" |
| 4784 | "rol" "ror" |
| 4785 | "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" |
| 4786 | "then" "to" "transport" "type" |
| 4787 | "unaffected" "units" "until" "use" |
| 4788 | "variable" |
| 4789 | "wait" "when" "while" "with" |
| 4790 | "xnor" "xor" |
| 4791 | ) |
| 4792 | "List of VHDL'93 keywords.") |
| 4793 | |
| 4794 | (defconst vhdl-ams-keywords |
| 4795 | '( |
| 4796 | "across" "break" "limit" "nature" "noise" "procedural" "quantity" |
| 4797 | "reference" "spectrum" "subnature" "terminal" "through" |
| 4798 | "tolerance" |
| 4799 | ) |
| 4800 | "List of VHDL-AMS keywords.") |
| 4801 | |
| 4802 | (defconst vhdl-verilog-keywords |
| 4803 | '( |
| 4804 | "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" |
| 4805 | "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" |
| 4806 | "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" |
| 4807 | "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" |
| 4808 | "endprimitive" "endspecify" "endtable" "endtask" "event" |
| 4809 | "for" "force" "forever" "fork" "function" |
| 4810 | "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" |
| 4811 | "macromodule" "makefile" "medium" "module" |
| 4812 | "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" |
| 4813 | "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" |
| 4814 | "pullup" |
| 4815 | "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" |
| 4816 | "rtranif0" "rtranif1" |
| 4817 | "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" |
| 4818 | "strong1" "supply" "supply0" "supply1" |
| 4819 | "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" |
| 4820 | "triand" "trior" "trireg" |
| 4821 | "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" |
| 4822 | ) |
| 4823 | "List of Verilog keywords as candidate for additional reserved words.") |
| 4824 | |
| 4825 | (defconst vhdl-93-types |
| 4826 | '( |
| 4827 | "boolean" "bit" "bit_vector" "character" "severity_level" "integer" |
| 4828 | "real" "time" "natural" "positive" "string" "line" "text" "side" |
| 4829 | "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" |
| 4830 | "std_logic" "std_logic_vector" |
| 4831 | "std_ulogic" "std_ulogic_vector" |
| 4832 | ) |
| 4833 | "List of VHDL'93 standardized types.") |
| 4834 | |
| 4835 | (defconst vhdl-ams-types |
| 4836 | '( |
| 4837 | "domain_type" "real_vector" |
| 4838 | ;; from `nature_pkg' package |
| 4839 | "voltage" "current" "electrical" "position" "velocity" "force" |
| 4840 | "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational" |
| 4841 | "pressure" "flowrate" "fluid" |
| 4842 | ) |
| 4843 | "List of VHDL-AMS standardized types.") |
| 4844 | |
| 4845 | (defconst vhdl-math-types |
| 4846 | '( |
| 4847 | "complex" "complex_polar" |
| 4848 | ) |
| 4849 | "List of Math Packages standardized types.") |
| 4850 | |
| 4851 | (defconst vhdl-93-attributes |
| 4852 | '( |
| 4853 | "base" "left" "right" "high" "low" "pos" "val" "succ" |
| 4854 | "pred" "leftof" "rightof" "range" "reverse_range" |
| 4855 | "length" "delayed" "stable" "quiet" "transaction" |
| 4856 | "event" "active" "last_event" "last_active" "last_value" |
| 4857 | "driving" "driving_value" "ascending" "value" "image" |
| 4858 | "simple_name" "instance_name" "path_name" |
| 4859 | "foreign" |
| 4860 | ) |
| 4861 | "List of VHDL'93 standardized attributes.") |
| 4862 | |
| 4863 | (defconst vhdl-ams-attributes |
| 4864 | '( |
| 4865 | "across" "through" |
| 4866 | "reference" "contribution" "tolerance" |
| 4867 | "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" |
| 4868 | "ramp" "slew" |
| 4869 | ) |
| 4870 | "List of VHDL-AMS standardized attributes.") |
| 4871 | |
| 4872 | (defconst vhdl-93-enum-values |
| 4873 | '( |
| 4874 | "true" "false" |
| 4875 | "note" "warning" "error" "failure" |
| 4876 | "read_mode" "write_mode" "append_mode" |
| 4877 | "open_ok" "status_error" "name_error" "mode_error" |
| 4878 | "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" |
| 4879 | "right" "left" |
| 4880 | ) |
| 4881 | "List of VHDL'93 standardized enumeration values.") |
| 4882 | |
| 4883 | (defconst vhdl-ams-enum-values |
| 4884 | '( |
| 4885 | "quiescent_domain" "time_domain" "frequency_domain" |
| 4886 | ;; from `nature_pkg' package |
| 4887 | "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" |
| 4888 | ) |
| 4889 | "List of VHDL-AMS standardized enumeration values.") |
| 4890 | |
| 4891 | (defconst vhdl-math-constants |
| 4892 | '( |
| 4893 | "math_e" "math_1_over_e" |
| 4894 | "math_pi" "math_two_pi" "math_1_over_pi" |
| 4895 | "math_half_pi" "math_q_pi" "math_3_half_pi" |
| 4896 | "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e" |
| 4897 | "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi" |
| 4898 | "math_deg_to_rad" "math_rad_to_deg" |
| 4899 | "cbase_1" "cbase_j" "czero" |
| 4900 | ) |
| 4901 | "List of Math Packages standardized constants.") |
| 4902 | |
| 4903 | (defconst vhdl-93-functions |
| 4904 | '( |
| 4905 | "now" "resolved" "rising_edge" "falling_edge" |
| 4906 | "read" "readline" "write" "writeline" "endfile" |
| 4907 | "resize" "is_X" "std_match" |
| 4908 | "shift_left" "shift_right" "rotate_left" "rotate_right" |
| 4909 | "to_unsigned" "to_signed" "to_integer" |
| 4910 | "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" |
| 4911 | "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" |
| 4912 | "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" |
| 4913 | "shl" "shr" "ext" "sxt" |
| 4914 | "deallocate" |
| 4915 | ) |
| 4916 | "List of VHDL'93 standardized functions.") |
| 4917 | |
| 4918 | (defconst vhdl-ams-functions |
| 4919 | '( |
| 4920 | "frequency" |
| 4921 | ) |
| 4922 | "List of VHDL-AMS standardized functions.") |
| 4923 | |
| 4924 | (defconst vhdl-math-functions |
| 4925 | '( |
| 4926 | "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform" |
| 4927 | "sqrt" "cbrt" "exp" "log" |
| 4928 | "sin" "cos" "tan" "arcsin" "arccos" "arctan" |
| 4929 | "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh" |
| 4930 | "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj" |
| 4931 | ) |
| 4932 | "List of Math Packages standardized functions.") |
| 4933 | |
| 4934 | (defconst vhdl-93-packages |
| 4935 | '( |
| 4936 | "std_logic_1164" "numeric_std" "numeric_bit" |
| 4937 | "standard" "textio" |
| 4938 | "std_logic_arith" "std_logic_signed" "std_logic_unsigned" |
| 4939 | "std_logic_misc" "std_logic_textio" |
| 4940 | "ieee" "std" "work" |
| 4941 | ) |
| 4942 | "List of VHDL'93 standardized packages and libraries.") |
| 4943 | |
| 4944 | (defconst vhdl-ams-packages |
| 4945 | '( |
| 4946 | ;; from `nature_pkg' package |
| 4947 | "nature_pkg" |
| 4948 | ) |
| 4949 | "List of VHDL-AMS standardized packages and libraries.") |
| 4950 | |
| 4951 | (defconst vhdl-math-packages |
| 4952 | '( |
| 4953 | "math_real" "math_complex" |
| 4954 | ) |
| 4955 | "List of Math Packages standardized packages and libraries.") |
| 4956 | |
| 4957 | (defvar vhdl-keywords nil |
| 4958 | "List of VHDL keywords.") |
| 4959 | |
| 4960 | (defvar vhdl-types nil |
| 4961 | "List of VHDL standardized types.") |
| 4962 | |
| 4963 | (defvar vhdl-attributes nil |
| 4964 | "List of VHDL standardized attributes.") |
| 4965 | |
| 4966 | (defvar vhdl-enum-values nil |
| 4967 | "List of VHDL standardized enumeration values.") |
| 4968 | |
| 4969 | (defvar vhdl-constants nil |
| 4970 | "List of VHDL standardized constants.") |
| 4971 | |
| 4972 | (defvar vhdl-functions nil |
| 4973 | "List of VHDL standardized functions.") |
| 4974 | |
| 4975 | (defvar vhdl-packages nil |
| 4976 | "List of VHDL standardized packages and libraries.") |
| 4977 | |
| 4978 | (defvar vhdl-reserved-words nil |
| 4979 | "List of additional reserved words.") |
| 4980 | |
| 4981 | (defvar vhdl-keywords-regexp nil |
| 4982 | "Regexp for VHDL keywords.") |
| 4983 | |
| 4984 | (defvar vhdl-types-regexp nil |
| 4985 | "Regexp for VHDL standardized types.") |
| 4986 | |
| 4987 | (defvar vhdl-attributes-regexp nil |
| 4988 | "Regexp for VHDL standardized attributes.") |
| 4989 | |
| 4990 | (defvar vhdl-enum-values-regexp nil |
| 4991 | "Regexp for VHDL standardized enumeration values.") |
| 4992 | |
| 4993 | (defvar vhdl-functions-regexp nil |
| 4994 | "Regexp for VHDL standardized functions.") |
| 4995 | |
| 4996 | (defvar vhdl-packages-regexp nil |
| 4997 | "Regexp for VHDL standardized packages and libraries.") |
| 4998 | |
| 4999 | (defvar vhdl-reserved-words-regexp nil |
| 5000 | "Regexp for additional reserved words.") |
| 5001 | |
| 5002 | (defvar vhdl-directive-keywords-regexp nil |
| 5003 | "Regexp for compiler directive keywords.") |
| 5004 | |
| 5005 | (defun vhdl-words-init () |
| 5006 | "Initialize reserved words." |
| 5007 | (setq vhdl-keywords |
| 5008 | (append vhdl-93-keywords |
| 5009 | (when (vhdl-standard-p 'ams) vhdl-ams-keywords))) |
| 5010 | (setq vhdl-types |
| 5011 | (append vhdl-93-types |
| 5012 | (when (vhdl-standard-p 'ams) vhdl-ams-types) |
| 5013 | (when (vhdl-standard-p 'math) vhdl-math-types))) |
| 5014 | (setq vhdl-attributes |
| 5015 | (append vhdl-93-attributes |
| 5016 | (when (vhdl-standard-p 'ams) vhdl-ams-attributes))) |
| 5017 | (setq vhdl-enum-values |
| 5018 | (append vhdl-93-enum-values |
| 5019 | (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))) |
| 5020 | (setq vhdl-constants |
| 5021 | (append (when (vhdl-standard-p 'math) vhdl-math-constants))) |
| 5022 | (setq vhdl-functions |
| 5023 | (append vhdl-93-functions |
| 5024 | (when (vhdl-standard-p 'ams) vhdl-ams-functions) |
| 5025 | (when (vhdl-standard-p 'math) vhdl-math-functions))) |
| 5026 | (setq vhdl-packages |
| 5027 | (append vhdl-93-packages |
| 5028 | (when (vhdl-standard-p 'ams) vhdl-ams-packages) |
| 5029 | (when (vhdl-standard-p 'math) vhdl-math-packages))) |
| 5030 | (setq vhdl-reserved-words |
| 5031 | (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) |
| 5032 | (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) |
| 5033 | '(""))) |
| 5034 | (setq vhdl-keywords-regexp |
| 5035 | (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) |
| 5036 | (setq vhdl-types-regexp |
| 5037 | (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) |
| 5038 | (setq vhdl-attributes-regexp |
| 5039 | (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) |
| 5040 | (setq vhdl-enum-values-regexp |
| 5041 | (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) |
| 5042 | (setq vhdl-functions-regexp |
| 5043 | (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) |
| 5044 | (setq vhdl-packages-regexp |
| 5045 | (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) |
| 5046 | (setq vhdl-reserved-words-regexp |
| 5047 | (concat "\\<\\(" |
| 5048 | (unless (equal vhdl-forbidden-syntax "") |
| 5049 | (concat vhdl-forbidden-syntax "\\|")) |
| 5050 | (regexp-opt vhdl-reserved-words) |
| 5051 | "\\)\\>")) |
| 5052 | (setq vhdl-directive-keywords-regexp |
| 5053 | (concat "\\<\\(" (mapconcat 'regexp-quote |
| 5054 | vhdl-directive-keywords "\\|") "\\)\\>")) |
| 5055 | (vhdl-abbrev-list-init)) |
| 5056 | |
| 5057 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5058 | ;; Words to expand |
| 5059 | |
| 5060 | (defvar vhdl-abbrev-list nil |
| 5061 | "Predefined abbreviations for VHDL.") |
| 5062 | |
| 5063 | (defun vhdl-abbrev-list-init () |
| 5064 | (setq vhdl-abbrev-list |
| 5065 | (append |
| 5066 | (list vhdl-upper-case-keywords) vhdl-keywords |
| 5067 | (list vhdl-upper-case-types) vhdl-types |
| 5068 | (list vhdl-upper-case-attributes) vhdl-attributes |
| 5069 | (list vhdl-upper-case-enum-values) vhdl-enum-values |
| 5070 | (list vhdl-upper-case-constants) vhdl-constants |
| 5071 | (list nil) vhdl-functions |
| 5072 | (list nil) vhdl-packages))) |
| 5073 | |
| 5074 | ;; initialize reserved words for VHDL Mode |
| 5075 | (vhdl-words-init) |
| 5076 | |
| 5077 | |
| 5078 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5079 | ;;; Indentation |
| 5080 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5081 | |
| 5082 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5083 | ;; Syntax analysis |
| 5084 | |
| 5085 | ;; constant regular expressions for looking at various constructs |
| 5086 | |
| 5087 | (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" |
| 5088 | "Regexp describing a VHDL symbol. |
| 5089 | We cannot use just `word' syntax class since `_' cannot be in word |
| 5090 | class. Putting underscore in word class breaks forward word movement |
| 5091 | behavior that users are familiar with.") |
| 5092 | |
| 5093 | (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is" |
| 5094 | "Regexp describing a case statement header key.") |
| 5095 | |
| 5096 | (defconst vhdl-label-key |
| 5097 | (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") |
| 5098 | "Regexp describing a VHDL label.") |
| 5099 | |
| 5100 | ;; Macro definitions: |
| 5101 | |
| 5102 | (defmacro vhdl-point (position) |
| 5103 | "Return the value of point at certain commonly referenced POSITIONs. |
| 5104 | POSITION can be one of the following symbols: |
| 5105 | |
| 5106 | bol -- beginning of line |
| 5107 | eol -- end of line |
| 5108 | bod -- beginning of defun |
| 5109 | boi -- back to indentation |
| 5110 | eoi -- last whitespace on line |
| 5111 | ionl -- indentation of next line |
| 5112 | iopl -- indentation of previous line |
| 5113 | bonl -- beginning of next line |
| 5114 | bopl -- beginning of previous line |
| 5115 | |
| 5116 | This function does not modify point or mark." |
| 5117 | (or (and (eq 'quote (car-safe position)) |
| 5118 | (null (cddr position))) |
| 5119 | (error "ERROR: Bad buffer position requested: %s" position)) |
| 5120 | (setq position (nth 1 position)) |
| 5121 | `(let ((here (point))) |
| 5122 | ,@(cond |
| 5123 | ((eq position 'bol) '((beginning-of-line))) |
| 5124 | ((eq position 'eol) '((end-of-line))) |
| 5125 | ((eq position 'bod) '((save-match-data |
| 5126 | (vhdl-beginning-of-defun)))) |
| 5127 | ((eq position 'boi) '((back-to-indentation))) |
| 5128 | ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t"))) |
| 5129 | ((eq position 'bonl) '((forward-line 1))) |
| 5130 | ((eq position 'bopl) '((forward-line -1))) |
| 5131 | ((eq position 'iopl) |
| 5132 | '((forward-line -1) |
| 5133 | (back-to-indentation))) |
| 5134 | ((eq position 'ionl) |
| 5135 | '((forward-line 1) |
| 5136 | (back-to-indentation))) |
| 5137 | (t (error "ERROR: Unknown buffer position requested: %s" position)) |
| 5138 | ) |
| 5139 | (prog1 |
| 5140 | (point) |
| 5141 | (goto-char here)) |
| 5142 | ;; workaround for an Emacs18 bug -- blech! Well, at least it |
| 5143 | ;; doesn't hurt for v19 |
| 5144 | ,@nil |
| 5145 | )) |
| 5146 | |
| 5147 | (defmacro vhdl-safe (&rest body) |
| 5148 | "Safely execute BODY, return nil if an error occurred." |
| 5149 | `(condition-case nil |
| 5150 | (progn ,@body) |
| 5151 | (error nil))) |
| 5152 | |
| 5153 | (defmacro vhdl-add-syntax (symbol &optional relpos) |
| 5154 | "A simple macro to append the syntax in SYMBOL to the syntax list. |
| 5155 | Try to increase performance by using this macro." |
| 5156 | `(setq vhdl-syntactic-context |
| 5157 | (cons (cons ,symbol ,relpos) vhdl-syntactic-context))) |
| 5158 | |
| 5159 | (defmacro vhdl-has-syntax (symbol) |
| 5160 | "A simple macro to return check the syntax list. |
| 5161 | Try to increase performance by using this macro." |
| 5162 | `(assoc ,symbol vhdl-syntactic-context)) |
| 5163 | |
| 5164 | ;; Syntactic element offset manipulation: |
| 5165 | |
| 5166 | (defun vhdl-read-offset (langelem) |
| 5167 | "Read new offset value for LANGELEM from minibuffer. |
| 5168 | Return a valid value only." |
| 5169 | (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) |
| 5170 | (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") |
| 5171 | (prompt "Offset: ") |
| 5172 | offset input interned) |
| 5173 | (while (not offset) |
| 5174 | (setq input (read-string prompt oldoff) |
| 5175 | offset (cond ((string-equal "+" input) '+) |
| 5176 | ((string-equal "-" input) '-) |
| 5177 | ((string-equal "++" input) '++) |
| 5178 | ((string-equal "--" input) '--) |
| 5179 | ((string-match "^-?[0-9]+$" input) |
| 5180 | (string-to-number input)) |
| 5181 | ((fboundp (setq interned (intern input))) |
| 5182 | interned) |
| 5183 | ((boundp interned) interned) |
| 5184 | ;; error, but don't signal one, keep trying |
| 5185 | ;; to read an input value |
| 5186 | (t (ding) |
| 5187 | (setq prompt errmsg) |
| 5188 | nil)))) |
| 5189 | offset)) |
| 5190 | |
| 5191 | (defun vhdl-set-offset (symbol offset &optional add-p) |
| 5192 | "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. |
| 5193 | SYMBOL is the syntactic element symbol to change and OFFSET is the new |
| 5194 | offset for that syntactic element. Optional ADD-P says to add SYMBOL to |
| 5195 | `vhdl-offsets-alist' if it doesn't already appear there." |
| 5196 | (interactive |
| 5197 | (let* ((langelem |
| 5198 | (intern (completing-read |
| 5199 | (concat "Syntactic symbol to change" |
| 5200 | (if current-prefix-arg " or add" "") |
| 5201 | ": ") |
| 5202 | (mapcar |
| 5203 | (function |
| 5204 | (lambda (langelem) |
| 5205 | (cons (format "%s" (car langelem)) nil))) |
| 5206 | vhdl-offsets-alist) |
| 5207 | nil (not current-prefix-arg) |
| 5208 | ;; initial contents tries to be the last element |
| 5209 | ;; on the syntactic analysis list for the current |
| 5210 | ;; line |
| 5211 | (let* ((syntax (vhdl-get-syntactic-context)) |
| 5212 | (len (length syntax)) |
| 5213 | (ic (format "%s" (car (nth (1- len) syntax))))) |
| 5214 | ic) |
| 5215 | ))) |
| 5216 | (offset (vhdl-read-offset langelem))) |
| 5217 | (list langelem offset current-prefix-arg))) |
| 5218 | ;; sanity check offset |
| 5219 | (or (eq offset '+) |
| 5220 | (eq offset '-) |
| 5221 | (eq offset '++) |
| 5222 | (eq offset '--) |
| 5223 | (integerp offset) |
| 5224 | (fboundp offset) |
| 5225 | (boundp offset) |
| 5226 | (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" |
| 5227 | offset)) |
| 5228 | (let ((entry (assq symbol vhdl-offsets-alist))) |
| 5229 | (if entry |
| 5230 | (setcdr entry offset) |
| 5231 | (if add-p |
| 5232 | (setq vhdl-offsets-alist |
| 5233 | (cons (cons symbol offset) vhdl-offsets-alist)) |
| 5234 | (error "ERROR: %s is not a valid syntactic symbol" symbol)))) |
| 5235 | (vhdl-keep-region-active)) |
| 5236 | |
| 5237 | (defun vhdl-set-style (style &optional local) |
| 5238 | "Set `vhdl-mode' variables to use one of several different indentation styles. |
| 5239 | STYLE is a string representing the desired style and optional LOCAL is |
| 5240 | a flag which, if non-nil, means to make the style variables being |
| 5241 | changed buffer local, instead of the default, which is to set the |
| 5242 | global variables. Interactively, the flag comes from the prefix |
| 5243 | argument. The styles are chosen from the `vhdl-style-alist' variable." |
| 5244 | (interactive (list (completing-read "Use which VHDL indentation style? " |
| 5245 | vhdl-style-alist nil t) |
| 5246 | current-prefix-arg)) |
| 5247 | (let ((vars (cdr (assoc style vhdl-style-alist)))) |
| 5248 | (or vars |
| 5249 | (error "ERROR: Invalid VHDL indentation style `%s'" style)) |
| 5250 | ;; set all the variables |
| 5251 | (mapc |
| 5252 | (function |
| 5253 | (lambda (varentry) |
| 5254 | (let ((var (car varentry)) |
| 5255 | (val (cdr varentry))) |
| 5256 | ;; special case for vhdl-offsets-alist |
| 5257 | (if (not (eq var 'vhdl-offsets-alist)) |
| 5258 | (set (if local (make-local-variable var) var) val) |
| 5259 | ;; reset vhdl-offsets-alist to the default value first |
| 5260 | (set (if local (make-local-variable var) var) |
| 5261 | (copy-alist vhdl-offsets-alist-default)) |
| 5262 | ;; now set the langelems that are different |
| 5263 | (mapcar |
| 5264 | (function |
| 5265 | (lambda (langentry) |
| 5266 | (let ((langelem (car langentry)) |
| 5267 | (offset (cdr langentry))) |
| 5268 | (vhdl-set-offset langelem offset) |
| 5269 | ))) |
| 5270 | val)) |
| 5271 | ))) |
| 5272 | vars)) |
| 5273 | (vhdl-keep-region-active)) |
| 5274 | |
| 5275 | (defun vhdl-get-offset (langelem) |
| 5276 | "Get offset from LANGELEM which is a cons cell of the form: |
| 5277 | \(SYMBOL . RELPOS). The symbol is matched against |
| 5278 | vhdl-offsets-alist and the offset found there is either returned, |
| 5279 | or added to the indentation at RELPOS. If RELPOS is nil, then |
| 5280 | the offset is simply returned." |
| 5281 | (let* ((symbol (car langelem)) |
| 5282 | (relpos (cdr langelem)) |
| 5283 | (match (assq symbol vhdl-offsets-alist)) |
| 5284 | (offset (cdr-safe match))) |
| 5285 | ;; offset can be a number, a function, a variable, or one of the |
| 5286 | ;; symbols + or - |
| 5287 | (cond |
| 5288 | ((not match) |
| 5289 | (if vhdl-strict-syntax-p |
| 5290 | (error "ERROR: Don't know how to indent a %s" symbol) |
| 5291 | (setq offset 0 |
| 5292 | relpos 0))) |
| 5293 | ((eq offset '+) (setq offset vhdl-basic-offset)) |
| 5294 | ((eq offset '-) (setq offset (- vhdl-basic-offset))) |
| 5295 | ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) |
| 5296 | ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) |
| 5297 | ((and (not (numberp offset)) |
| 5298 | (fboundp offset)) |
| 5299 | (setq offset (funcall offset langelem))) |
| 5300 | ((not (numberp offset)) |
| 5301 | (setq offset (eval offset))) |
| 5302 | ) |
| 5303 | (+ (if (and relpos |
| 5304 | (< relpos (vhdl-point 'bol))) |
| 5305 | (save-excursion |
| 5306 | (goto-char relpos) |
| 5307 | (current-column)) |
| 5308 | 0) |
| 5309 | offset))) |
| 5310 | |
| 5311 | ;; Syntactic support functions: |
| 5312 | |
| 5313 | (defun vhdl-in-comment-p () |
| 5314 | "Check if point is in a comment." |
| 5315 | (eq (vhdl-in-literal) 'comment)) |
| 5316 | |
| 5317 | (defun vhdl-in-string-p () |
| 5318 | "Check if point is in a string." |
| 5319 | (eq (vhdl-in-literal) 'string)) |
| 5320 | |
| 5321 | (defun vhdl-in-literal () |
| 5322 | "Determine if point is in a VHDL literal." |
| 5323 | (save-excursion |
| 5324 | (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) |
| 5325 | (cond |
| 5326 | ((nth 3 state) 'string) |
| 5327 | ((nth 4 state) 'comment) |
| 5328 | ((vhdl-beginning-of-macro) 'pound) |
| 5329 | (t nil))))) |
| 5330 | |
| 5331 | (defun vhdl-forward-comment (&optional direction) |
| 5332 | "Skip all comments (including whitespace). Skip backwards if DIRECTION is |
| 5333 | negative, skip forward otherwise." |
| 5334 | (interactive "p") |
| 5335 | (if (and direction (< direction 0)) |
| 5336 | ;; skip backwards |
| 5337 | (progn |
| 5338 | (skip-chars-backward " \t\n") |
| 5339 | (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) |
| 5340 | (goto-char (match-beginning 3)) |
| 5341 | (skip-chars-backward " \t\n"))) |
| 5342 | ;; skip forwards |
| 5343 | (skip-chars-forward " \t\n") |
| 5344 | (while (looking-at "--.*") |
| 5345 | (goto-char (match-end 0)) |
| 5346 | (skip-chars-forward " \t\n")))) |
| 5347 | |
| 5348 | ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ |
| 5349 | (unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) |
| 5350 | (defalias 'vhdl-forward-comment 'forward-comment)) |
| 5351 | |
| 5352 | ;; This is the best we can do in Win-Emacs. |
| 5353 | (defun vhdl-win-il (&optional lim) |
| 5354 | "Determine if point is in a VHDL literal." |
| 5355 | (save-excursion |
| 5356 | (let* ((here (point)) |
| 5357 | (state nil) |
| 5358 | (match nil) |
| 5359 | (lim (or lim (vhdl-point 'bod)))) |
| 5360 | (goto-char lim ) |
| 5361 | (while (< (point) here) |
| 5362 | (setq match |
| 5363 | (and (re-search-forward "--\\|[\"']" |
| 5364 | here 'move) |
| 5365 | (buffer-substring (match-beginning 0) (match-end 0)))) |
| 5366 | (setq state |
| 5367 | (cond |
| 5368 | ;; no match |
| 5369 | ((null match) nil) |
| 5370 | ;; looking at the opening of a VHDL style comment |
| 5371 | ((string= "--" match) |
| 5372 | (if (<= here (progn (end-of-line) (point))) 'comment)) |
| 5373 | ;; looking at the opening of a double quote string |
| 5374 | ((string= "\"" match) |
| 5375 | (if (not (save-restriction |
| 5376 | ;; this seems to be necessary since the |
| 5377 | ;; re-search-forward will not work without it |
| 5378 | (narrow-to-region (point) here) |
| 5379 | (re-search-forward |
| 5380 | ;; this regexp matches a double quote |
| 5381 | ;; which is preceded by an even number |
| 5382 | ;; of backslashes, including zero |
| 5383 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) |
| 5384 | 'string)) |
| 5385 | ;; looking at the opening of a single quote string |
| 5386 | ((string= "'" match) |
| 5387 | (if (not (save-restriction |
| 5388 | ;; see comments from above |
| 5389 | (narrow-to-region (point) here) |
| 5390 | (re-search-forward |
| 5391 | ;; this matches a single quote which is |
| 5392 | ;; preceded by zero or two backslashes. |
| 5393 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" |
| 5394 | here 'move))) |
| 5395 | 'string)) |
| 5396 | (t nil))) |
| 5397 | ) ; end-while |
| 5398 | state))) |
| 5399 | |
| 5400 | (and (string-match "Win-Emacs" emacs-version) |
| 5401 | (fset 'vhdl-in-literal 'vhdl-win-il)) |
| 5402 | |
| 5403 | ;; Skipping of "syntactic whitespace". Syntactic whitespace is |
| 5404 | ;; defined as lexical whitespace or comments. Search no farther back |
| 5405 | ;; or forward than optional LIM. If LIM is omitted, (point-min) is |
| 5406 | ;; used for backward skipping, (point-max) is used for forward |
| 5407 | ;; skipping. |
| 5408 | |
| 5409 | (defun vhdl-forward-syntactic-ws (&optional lim) |
| 5410 | "Forward skip of syntactic whitespace." |
| 5411 | (let* ((here (point-max)) |
| 5412 | (hugenum (point-max))) |
| 5413 | (while (/= here (point)) |
| 5414 | (setq here (point)) |
| 5415 | (vhdl-forward-comment hugenum) |
| 5416 | ;; skip preprocessor directives |
| 5417 | (when (and (eq (char-after) ?#) |
| 5418 | (= (vhdl-point 'boi) (point))) |
| 5419 | (while (and (eq (char-before (vhdl-point 'eol)) ?\\) |
| 5420 | (= (forward-line 1) 0))) |
| 5421 | (end-of-line))) |
| 5422 | (if lim (goto-char (min (point) lim))))) |
| 5423 | |
| 5424 | |
| 5425 | ;; This is the best we can do in Win-Emacs. |
| 5426 | (defun vhdl-win-fsws (&optional lim) |
| 5427 | "Forward skip syntactic whitespace for Win-Emacs." |
| 5428 | (let ((lim (or lim (point-max))) |
| 5429 | stop) |
| 5430 | (while (not stop) |
| 5431 | (skip-chars-forward " \t\n\r\f" lim) |
| 5432 | (cond |
| 5433 | ;; vhdl comment |
| 5434 | ((looking-at "--") (end-of-line)) |
| 5435 | ;; none of the above |
| 5436 | (t (setq stop t)))))) |
| 5437 | |
| 5438 | (and (string-match "Win-Emacs" emacs-version) |
| 5439 | (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) |
| 5440 | |
| 5441 | (defun vhdl-beginning-of-macro (&optional lim) |
| 5442 | "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." |
| 5443 | (let ((here (point))) |
| 5444 | (beginning-of-line) |
| 5445 | (while (eq (char-before (1- (point))) ?\\) |
| 5446 | (forward-line -1)) |
| 5447 | (back-to-indentation) |
| 5448 | (if (and (<= (point) here) |
| 5449 | (eq (char-after) ?#)) |
| 5450 | t |
| 5451 | (goto-char here) |
| 5452 | nil))) |
| 5453 | |
| 5454 | (defun vhdl-backward-syntactic-ws (&optional lim) |
| 5455 | "Backward skip over syntactic whitespace." |
| 5456 | (let* ((here (point-min)) |
| 5457 | (hugenum (- (point-max)))) |
| 5458 | (while (/= here (point)) |
| 5459 | (setq here (point)) |
| 5460 | (vhdl-forward-comment hugenum) |
| 5461 | (vhdl-beginning-of-macro)) |
| 5462 | (if lim (goto-char (max (point) lim))))) |
| 5463 | |
| 5464 | ;; This is the best we can do in Win-Emacs. |
| 5465 | (defun vhdl-win-bsws (&optional lim) |
| 5466 | "Backward skip syntactic whitespace for Win-Emacs." |
| 5467 | (let ((lim (or lim (vhdl-point 'bod))) |
| 5468 | stop) |
| 5469 | (while (not stop) |
| 5470 | (skip-chars-backward " \t\n\r\f" lim) |
| 5471 | (cond |
| 5472 | ;; vhdl comment |
| 5473 | ((eq (vhdl-in-literal) 'comment) |
| 5474 | (skip-chars-backward "^-" lim) |
| 5475 | (skip-chars-backward "-" lim) |
| 5476 | (while (not (or (and (= (following-char) ?-) |
| 5477 | (= (char-after (1+ (point))) ?-)) |
| 5478 | (<= (point) lim))) |
| 5479 | (skip-chars-backward "^-" lim) |
| 5480 | (skip-chars-backward "-" lim))) |
| 5481 | ;; none of the above |
| 5482 | (t (setq stop t)))))) |
| 5483 | |
| 5484 | (and (string-match "Win-Emacs" emacs-version) |
| 5485 | (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) |
| 5486 | |
| 5487 | ;; Functions to help finding the correct indentation column: |
| 5488 | |
| 5489 | (defun vhdl-first-word (point) |
| 5490 | "If the keyword at POINT is at boi, then return (current-column) at |
| 5491 | that point, else nil." |
| 5492 | (save-excursion |
| 5493 | (and (goto-char point) |
| 5494 | (eq (point) (vhdl-point 'boi)) |
| 5495 | (current-column)))) |
| 5496 | |
| 5497 | (defun vhdl-last-word (point) |
| 5498 | "If the keyword at POINT is at eoi, then return (current-column) at |
| 5499 | that point, else nil." |
| 5500 | (save-excursion |
| 5501 | (and (goto-char point) |
| 5502 | (save-excursion (or (eq (progn (forward-sexp) (point)) |
| 5503 | (vhdl-point 'eoi)) |
| 5504 | (looking-at "\\s-*\\(--\\)?"))) |
| 5505 | (current-column)))) |
| 5506 | |
| 5507 | ;; Core syntactic evaluation functions: |
| 5508 | |
| 5509 | (defconst vhdl-libunit-re |
| 5510 | "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]") |
| 5511 | |
| 5512 | (defun vhdl-libunit-p () |
| 5513 | (and |
| 5514 | (save-excursion |
| 5515 | (forward-sexp) |
| 5516 | (skip-chars-forward " \t\n") |
| 5517 | (not (looking-at "is\\b[^_]"))) |
| 5518 | (save-excursion |
| 5519 | (backward-sexp) |
| 5520 | (and (not (looking-at "use\\b[^_]")) |
| 5521 | (progn |
| 5522 | (forward-sexp) |
| 5523 | (vhdl-forward-syntactic-ws) |
| 5524 | (/= (following-char) ?:)))) |
| 5525 | )) |
| 5526 | |
| 5527 | (defconst vhdl-defun-re |
| 5528 | "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") |
| 5529 | |
| 5530 | (defun vhdl-defun-p () |
| 5531 | (save-excursion |
| 5532 | (if (looking-at "block\\|process\\|procedural") |
| 5533 | ;; "block", "process", "procedural": |
| 5534 | (save-excursion |
| 5535 | (backward-sexp) |
| 5536 | (not (looking-at "end\\s-+\\w"))) |
| 5537 | ;; "architecture", "configuration", "entity", |
| 5538 | ;; "package", "procedure", "function": |
| 5539 | t))) |
| 5540 | |
| 5541 | (defun vhdl-corresponding-defun () |
| 5542 | "If the word at the current position corresponds to a \"defun\" |
| 5543 | keyword, then return a string that can be used to find the |
| 5544 | corresponding \"begin\" keyword, else return nil." |
| 5545 | (save-excursion |
| 5546 | (and (looking-at vhdl-defun-re) |
| 5547 | (vhdl-defun-p) |
| 5548 | (if (looking-at "block\\|process\\|procedural") |
| 5549 | ;; "block", "process". "procedural: |
| 5550 | (buffer-substring (match-beginning 0) (match-end 0)) |
| 5551 | ;; "architecture", "configuration", "entity", "package", |
| 5552 | ;; "procedure", "function": |
| 5553 | "is")))) |
| 5554 | |
| 5555 | (defconst vhdl-begin-fwd-re |
| 5556 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)" |
| 5557 | "A regular expression for searching forward that matches all known |
| 5558 | \"begin\" keywords.") |
| 5559 | |
| 5560 | (defconst vhdl-begin-bwd-re |
| 5561 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b[^_]" |
| 5562 | "A regular expression for searching backward that matches all known |
| 5563 | \"begin\" keywords.") |
| 5564 | |
| 5565 | (defun vhdl-begin-p (&optional lim) |
| 5566 | "Return t if we are looking at a real \"begin\" keyword. |
| 5567 | Assumes that the caller will make sure that we are looking at |
| 5568 | vhdl-begin-fwd-re, and are not inside a literal, and that we are not in |
| 5569 | the middle of an identifier that just happens to contain a \"begin\" |
| 5570 | keyword." |
| 5571 | (cond |
| 5572 | ;; "[architecture|case|configuration|entity|package| |
| 5573 | ;; procedure|function] ... is": |
| 5574 | ((and (looking-at "i") |
| 5575 | (save-excursion |
| 5576 | ;; Skip backward over first sexp (needed to skip over a |
| 5577 | ;; procedure interface list, and is harmless in other |
| 5578 | ;; situations). Note that we need "return" in the |
| 5579 | ;; following search list so that we don't run into |
| 5580 | ;; semicolons in the function interface list. |
| 5581 | (backward-sexp) |
| 5582 | (let (foundp) |
| 5583 | (while (and (not foundp) |
| 5584 | (re-search-backward |
| 5585 | ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" |
| 5586 | lim 'move)) |
| 5587 | (if (or (= (preceding-char) ?_) |
| 5588 | (vhdl-in-literal)) |
| 5589 | (backward-char) |
| 5590 | (setq foundp t)))) |
| 5591 | (and (/= (following-char) ?\;) |
| 5592 | (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) |
| 5593 | t) |
| 5594 | ;; "begin", "then": |
| 5595 | ((looking-at "be\\|t") |
| 5596 | t) |
| 5597 | ;; "else": |
| 5598 | ((and (looking-at "e") |
| 5599 | ;; make sure that the "else" isn't inside a |
| 5600 | ;; conditional signal assignment. |
| 5601 | (save-excursion |
| 5602 | (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) |
| 5603 | (or (eq (following-char) ?\;) |
| 5604 | (eq (point) lim)))) |
| 5605 | t) |
| 5606 | ;; "block", "generate", "loop", "process", "procedural", |
| 5607 | ;; "units", "record": |
| 5608 | ((and (looking-at "bl\\|[glpur]") |
| 5609 | (save-excursion |
| 5610 | (backward-sexp) |
| 5611 | (not (looking-at "end\\s-+\\w")))) |
| 5612 | t) |
| 5613 | ;; "component": |
| 5614 | ((and (looking-at "c") |
| 5615 | (save-excursion |
| 5616 | (backward-sexp) |
| 5617 | (not (looking-at "end\\s-+\\w"))) |
| 5618 | ;; look out for the dreaded entity class in an attribute |
| 5619 | (save-excursion |
| 5620 | (vhdl-backward-syntactic-ws lim) |
| 5621 | (/= (preceding-char) ?:))) |
| 5622 | t) |
| 5623 | ;; "for" (inside configuration declaration): |
| 5624 | ((and (looking-at "f") |
| 5625 | (save-excursion |
| 5626 | (backward-sexp) |
| 5627 | (not (looking-at "end\\s-+\\w"))) |
| 5628 | (vhdl-has-syntax 'configuration)) |
| 5629 | t) |
| 5630 | )) |
| 5631 | |
| 5632 | (defun vhdl-corresponding-mid (&optional lim) |
| 5633 | (cond |
| 5634 | ((looking-at "is\\|block\\|generate\\|process\\|procedural") |
| 5635 | "begin") |
| 5636 | ((looking-at "then") |
| 5637 | "<else>") |
| 5638 | (t |
| 5639 | "end"))) |
| 5640 | |
| 5641 | (defun vhdl-corresponding-end (&optional lim) |
| 5642 | "If the word at the current position corresponds to a \"begin\" |
| 5643 | keyword, then return a vector containing enough information to find |
| 5644 | the corresponding \"end\" keyword, else return nil. The keyword to |
| 5645 | search forward for is aref 0. The column in which the keyword must |
| 5646 | appear is aref 1 or nil if any column is suitable. |
| 5647 | Assumes that the caller will make sure that we are not in the middle |
| 5648 | of an identifier that just happens to contain a \"begin\" keyword." |
| 5649 | (save-excursion |
| 5650 | (and (looking-at vhdl-begin-fwd-re) |
| 5651 | (/= (preceding-char) ?_) |
| 5652 | (not (vhdl-in-literal)) |
| 5653 | (vhdl-begin-p lim) |
| 5654 | (cond |
| 5655 | ;; "is", "generate", "loop": |
| 5656 | ((looking-at "[igl]") |
| 5657 | (vector "end" |
| 5658 | (and (vhdl-last-word (point)) |
| 5659 | (or (vhdl-first-word (point)) |
| 5660 | (save-excursion |
| 5661 | (vhdl-beginning-of-statement-1 lim) |
| 5662 | (vhdl-backward-skip-label lim) |
| 5663 | (vhdl-first-word (point))))))) |
| 5664 | ;; "begin", "else", "for": |
| 5665 | ((looking-at "be\\|[ef]") |
| 5666 | (vector "end" |
| 5667 | (and (vhdl-last-word (point)) |
| 5668 | (or (vhdl-first-word (point)) |
| 5669 | (save-excursion |
| 5670 | (vhdl-beginning-of-statement-1 lim) |
| 5671 | (vhdl-backward-skip-label lim) |
| 5672 | (vhdl-first-word (point))))))) |
| 5673 | ;; "component", "units", "record": |
| 5674 | ((looking-at "[cur]") |
| 5675 | ;; The first end found will close the block |
| 5676 | (vector "end" nil)) |
| 5677 | ;; "block", "process", "procedural": |
| 5678 | ((looking-at "bl\\|p") |
| 5679 | (vector "end" |
| 5680 | (or (vhdl-first-word (point)) |
| 5681 | (save-excursion |
| 5682 | (vhdl-beginning-of-statement-1 lim) |
| 5683 | (vhdl-backward-skip-label lim) |
| 5684 | (vhdl-first-word (point)))))) |
| 5685 | ;; "then": |
| 5686 | ((looking-at "t") |
| 5687 | (vector "elsif\\|else\\|end\\s-+if" |
| 5688 | (and (vhdl-last-word (point)) |
| 5689 | (or (vhdl-first-word (point)) |
| 5690 | (save-excursion |
| 5691 | (vhdl-beginning-of-statement-1 lim) |
| 5692 | (vhdl-backward-skip-label lim) |
| 5693 | (vhdl-first-word (point))))))) |
| 5694 | )))) |
| 5695 | |
| 5696 | (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") |
| 5697 | |
| 5698 | (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") |
| 5699 | |
| 5700 | (defun vhdl-end-p (&optional lim) |
| 5701 | "Return t if we are looking at a real \"end\" keyword. |
| 5702 | Assumes that the caller will make sure that we are looking at |
| 5703 | vhdl-end-fwd-re, and are not inside a literal, and that we are not in |
| 5704 | the middle of an identifier that just happens to contain an \"end\" |
| 5705 | keyword." |
| 5706 | (or (not (looking-at "else")) |
| 5707 | ;; make sure that the "else" isn't inside a conditional signal |
| 5708 | ;; assignment. |
| 5709 | (save-excursion |
| 5710 | (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) |
| 5711 | (or (eq (following-char) ?\;) |
| 5712 | (eq (point) lim) |
| 5713 | (vhdl-in-literal))))) |
| 5714 | |
| 5715 | (defun vhdl-corresponding-begin (&optional lim) |
| 5716 | "If the word at the current position corresponds to an \"end\" |
| 5717 | keyword, then return a vector containing enough information to find |
| 5718 | the corresponding \"begin\" keyword, else return nil. The keyword to |
| 5719 | search backward for is aref 0. The column in which the keyword must |
| 5720 | appear is aref 1 or nil if any column is suitable. The supplementary |
| 5721 | keyword to search forward for is aref 2 or nil if this is not |
| 5722 | required. If aref 3 is t, then the \"begin\" keyword may be found in |
| 5723 | the middle of a statement. |
| 5724 | Assumes that the caller will make sure that we are not in the middle |
| 5725 | of an identifier that just happens to contain an \"end\" keyword." |
| 5726 | (save-excursion |
| 5727 | (let (pos) |
| 5728 | (if (and (looking-at vhdl-end-fwd-re) |
| 5729 | (not (vhdl-in-literal)) |
| 5730 | (vhdl-end-p lim)) |
| 5731 | (if (looking-at "el") |
| 5732 | ;; "else", "elsif": |
| 5733 | (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil) |
| 5734 | ;; "end ...": |
| 5735 | (setq pos (point)) |
| 5736 | (forward-sexp) |
| 5737 | (skip-chars-forward " \t\n") |
| 5738 | (cond |
| 5739 | ;; "end if": |
| 5740 | ((looking-at "if\\b[^_]") |
| 5741 | (vector "else\\|elsif\\|if" |
| 5742 | (vhdl-first-word pos) |
| 5743 | "else\\|then" nil)) |
| 5744 | ;; "end component": |
| 5745 | ((looking-at "component\\b[^_]") |
| 5746 | (vector (buffer-substring (match-beginning 1) |
| 5747 | (match-end 1)) |
| 5748 | (vhdl-first-word pos) |
| 5749 | nil nil)) |
| 5750 | ;; "end units", "end record": |
| 5751 | ((looking-at "\\(units\\|record\\)\\b[^_]") |
| 5752 | (vector (buffer-substring (match-beginning 1) |
| 5753 | (match-end 1)) |
| 5754 | (vhdl-first-word pos) |
| 5755 | nil t)) |
| 5756 | ;; "end block", "end process", "end procedural": |
| 5757 | ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") |
| 5758 | (vector "begin" (vhdl-first-word pos) nil nil)) |
| 5759 | ;; "end case": |
| 5760 | ((looking-at "case\\b[^_]") |
| 5761 | (vector "case" (vhdl-first-word pos) "is" nil)) |
| 5762 | ;; "end generate": |
| 5763 | ((looking-at "generate\\b[^_]") |
| 5764 | (vector "generate\\|for\\|if" |
| 5765 | (vhdl-first-word pos) |
| 5766 | "generate" nil)) |
| 5767 | ;; "end loop": |
| 5768 | ((looking-at "loop\\b[^_]") |
| 5769 | (vector "loop\\|while\\|for" |
| 5770 | (vhdl-first-word pos) |
| 5771 | "loop" nil)) |
| 5772 | ;; "end for" (inside configuration declaration): |
| 5773 | ((looking-at "for\\b[^_]") |
| 5774 | (vector "for" (vhdl-first-word pos) nil nil)) |
| 5775 | ;; "end [id]": |
| 5776 | (t |
| 5777 | (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function" |
| 5778 | (vhdl-first-word pos) |
| 5779 | ;; return an alist of (statement . keyword) mappings |
| 5780 | '( |
| 5781 | ;; "begin ... end [id]": |
| 5782 | ("begin" . nil) |
| 5783 | ;; "architecture ... is ... begin ... end [id]": |
| 5784 | ("architecture" . "is") |
| 5785 | ;; "configuration ... is ... end [id]": |
| 5786 | ("configuration" . "is") |
| 5787 | ;; "entity ... is ... end [id]": |
| 5788 | ("entity" . "is") |
| 5789 | ;; "package ... is ... end [id]": |
| 5790 | ("package" . "is") |
| 5791 | ;; "procedure ... is ... begin ... end [id]": |
| 5792 | ("procedure" . "is") |
| 5793 | ;; "function ... is ... begin ... end [id]": |
| 5794 | ("function" . "is") |
| 5795 | ) |
| 5796 | nil)) |
| 5797 | ))) ; "end ..." |
| 5798 | ))) |
| 5799 | |
| 5800 | (defconst vhdl-leader-re |
| 5801 | "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") |
| 5802 | |
| 5803 | (defun vhdl-end-of-leader () |
| 5804 | (save-excursion |
| 5805 | (cond ((looking-at "block\\|process\\|procedural") |
| 5806 | (if (save-excursion |
| 5807 | (forward-sexp) |
| 5808 | (skip-chars-forward " \t\n") |
| 5809 | (= (following-char) ?\()) |
| 5810 | (forward-sexp 2) |
| 5811 | (forward-sexp)) |
| 5812 | (when (looking-at "[ \t\n]*is") |
| 5813 | (goto-char (match-end 0))) |
| 5814 | (point)) |
| 5815 | ((looking-at "component") |
| 5816 | (forward-sexp 2) |
| 5817 | (when (looking-at "[ \t\n]*is") |
| 5818 | (goto-char (match-end 0))) |
| 5819 | (point)) |
| 5820 | ((looking-at "for") |
| 5821 | (forward-sexp 2) |
| 5822 | (skip-chars-forward " \t\n") |
| 5823 | (while (looking-at "[,:(]") |
| 5824 | (forward-sexp) |
| 5825 | (skip-chars-forward " \t\n")) |
| 5826 | (point)) |
| 5827 | (t nil) |
| 5828 | ))) |
| 5829 | |
| 5830 | (defconst vhdl-trailer-re |
| 5831 | "\\b\\(is\\|then\\|generate\\|loop\\|record\\)\\b[^_]") |
| 5832 | |
| 5833 | (defconst vhdl-statement-fwd-re |
| 5834 | "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)" |
| 5835 | "A regular expression for searching forward that matches all known |
| 5836 | \"statement\" keywords.") |
| 5837 | |
| 5838 | (defconst vhdl-statement-bwd-re |
| 5839 | "\\b\\(if\\|for\\|while\\)\\b[^_]" |
| 5840 | "A regular expression for searching backward that matches all known |
| 5841 | \"statement\" keywords.") |
| 5842 | |
| 5843 | (defun vhdl-statement-p (&optional lim) |
| 5844 | "Return t if we are looking at a real \"statement\" keyword. |
| 5845 | Assumes that the caller will make sure that we are looking at |
| 5846 | vhdl-statement-fwd-re, and are not inside a literal, and that we are not |
| 5847 | in the middle of an identifier that just happens to contain a |
| 5848 | \"statement\" keyword." |
| 5849 | (cond |
| 5850 | ;; "for" ... "generate": |
| 5851 | ((and (looking-at "f") |
| 5852 | ;; Make sure it's the start of a parameter specification. |
| 5853 | (save-excursion |
| 5854 | (forward-sexp 2) |
| 5855 | (skip-chars-forward " \t\n") |
| 5856 | (looking-at "in\\b[^_]")) |
| 5857 | ;; Make sure it's not an "end for". |
| 5858 | (save-excursion |
| 5859 | (backward-sexp) |
| 5860 | (not (looking-at "end\\s-+\\w")))) |
| 5861 | t) |
| 5862 | ;; "if" ... "then", "if" ... "generate", "if" ... "loop": |
| 5863 | ((and (looking-at "i") |
| 5864 | ;; Make sure it's not an "end if". |
| 5865 | (save-excursion |
| 5866 | (backward-sexp) |
| 5867 | (not (looking-at "end\\s-+\\w")))) |
| 5868 | t) |
| 5869 | ;; "while" ... "loop": |
| 5870 | ((looking-at "w") |
| 5871 | t) |
| 5872 | )) |
| 5873 | |
| 5874 | (defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>" |
| 5875 | "Regexp describing a case statement alternative key.") |
| 5876 | |
| 5877 | (defun vhdl-case-alternative-p (&optional lim) |
| 5878 | "Return t if we are looking at a real case alternative. |
| 5879 | Assumes that the caller will make sure that we are looking at |
| 5880 | vhdl-case-alternative-re, and are not inside a literal, and that |
| 5881 | we are not in the middle of an identifier that just happens to |
| 5882 | contain a \"when\" keyword." |
| 5883 | (save-excursion |
| 5884 | (let (foundp) |
| 5885 | (while (and (not foundp) |
| 5886 | (re-search-backward ";\\|<=" lim 'move)) |
| 5887 | (if (or (= (preceding-char) ?_) |
| 5888 | (vhdl-in-literal)) |
| 5889 | (backward-char) |
| 5890 | (setq foundp t))) |
| 5891 | (or (eq (following-char) ?\;) |
| 5892 | (eq (point) lim))) |
| 5893 | )) |
| 5894 | |
| 5895 | ;; Core syntactic movement functions: |
| 5896 | |
| 5897 | (defconst vhdl-b-t-b-re |
| 5898 | (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) |
| 5899 | |
| 5900 | (defun vhdl-backward-to-block (&optional lim) |
| 5901 | "Move backward to the previous \"begin\" or \"end\" keyword." |
| 5902 | (let (foundp) |
| 5903 | (while (and (not foundp) |
| 5904 | (re-search-backward vhdl-b-t-b-re lim 'move)) |
| 5905 | (if (or (= (preceding-char) ?_) |
| 5906 | (vhdl-in-literal)) |
| 5907 | (backward-char) |
| 5908 | (cond |
| 5909 | ;; "begin" keyword: |
| 5910 | ((and (looking-at vhdl-begin-fwd-re) |
| 5911 | (/= (preceding-char) ?_) |
| 5912 | (vhdl-begin-p lim)) |
| 5913 | (setq foundp 'begin)) |
| 5914 | ;; "end" keyword: |
| 5915 | ((and (looking-at vhdl-end-fwd-re) |
| 5916 | (/= (preceding-char) ?_) |
| 5917 | (vhdl-end-p lim)) |
| 5918 | (setq foundp 'end)) |
| 5919 | )) |
| 5920 | ) |
| 5921 | foundp |
| 5922 | )) |
| 5923 | |
| 5924 | (defun vhdl-forward-sexp (&optional count lim) |
| 5925 | "Move forward across one balanced expression (sexp). |
| 5926 | With COUNT, do it that many times." |
| 5927 | (interactive "p") |
| 5928 | (let ((count (or count 1)) |
| 5929 | (case-fold-search t) |
| 5930 | end-vec target) |
| 5931 | (save-excursion |
| 5932 | (while (> count 0) |
| 5933 | ;; skip whitespace |
| 5934 | (skip-chars-forward " \t\n") |
| 5935 | ;; Check for an unbalanced "end" keyword |
| 5936 | (if (and (looking-at vhdl-end-fwd-re) |
| 5937 | (/= (preceding-char) ?_) |
| 5938 | (not (vhdl-in-literal)) |
| 5939 | (vhdl-end-p lim) |
| 5940 | (not (looking-at "else"))) |
| 5941 | (error |
| 5942 | "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) |
| 5943 | ;; If the current keyword is a "begin" keyword, then find the |
| 5944 | ;; corresponding "end" keyword. |
| 5945 | (if (setq end-vec (vhdl-corresponding-end lim)) |
| 5946 | (let ( |
| 5947 | ;; end-re is the statement keyword to search for |
| 5948 | (end-re |
| 5949 | (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) |
| 5950 | ;; column is either the statement keyword target column |
| 5951 | ;; or nil |
| 5952 | (column (aref end-vec 1)) |
| 5953 | (eol (vhdl-point 'eol)) |
| 5954 | foundp literal placeholder) |
| 5955 | ;; Look for the statement keyword. |
| 5956 | (while (and (not foundp) |
| 5957 | (re-search-forward end-re nil t) |
| 5958 | (setq placeholder (match-end 1)) |
| 5959 | (goto-char (match-beginning 0))) |
| 5960 | ;; If we are in a literal, or not in the right target |
| 5961 | ;; column and not on the same line as the begin, then |
| 5962 | ;; try again. |
| 5963 | (if (or (and column |
| 5964 | (/= (current-indentation) column) |
| 5965 | (> (point) eol)) |
| 5966 | (= (preceding-char) ?_) |
| 5967 | (setq literal (vhdl-in-literal))) |
| 5968 | (if (eq literal 'comment) |
| 5969 | (end-of-line) |
| 5970 | (forward-char)) |
| 5971 | ;; An "else" keyword corresponds to both the opening brace |
| 5972 | ;; of the following sexp and the closing brace of the |
| 5973 | ;; previous sexp. |
| 5974 | (if (not (looking-at "else")) |
| 5975 | (goto-char placeholder)) |
| 5976 | (setq foundp t)) |
| 5977 | ) |
| 5978 | (if (not foundp) |
| 5979 | (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) |
| 5980 | ) |
| 5981 | ;; If the current keyword is not a "begin" keyword, then just |
| 5982 | ;; perform the normal forward-sexp. |
| 5983 | (forward-sexp) |
| 5984 | ) |
| 5985 | (setq count (1- count)) |
| 5986 | ) |
| 5987 | (setq target (point))) |
| 5988 | (goto-char target) |
| 5989 | nil)) |
| 5990 | |
| 5991 | (defun vhdl-backward-sexp (&optional count lim) |
| 5992 | "Move backward across one balanced expression (sexp). |
| 5993 | With COUNT, do it that many times. LIM bounds any required backward |
| 5994 | searches." |
| 5995 | (interactive "p") |
| 5996 | (let ((count (or count 1)) |
| 5997 | (case-fold-search t) |
| 5998 | begin-vec target) |
| 5999 | (save-excursion |
| 6000 | (while (> count 0) |
| 6001 | ;; Perform the normal backward-sexp, unless we are looking at |
| 6002 | ;; "else" - an "else" keyword corresponds to both the opening brace |
| 6003 | ;; of the following sexp and the closing brace of the previous sexp. |
| 6004 | (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") |
| 6005 | (/= (preceding-char) ?_) |
| 6006 | (not (vhdl-in-literal))) |
| 6007 | nil |
| 6008 | (backward-sexp) |
| 6009 | (if (and (looking-at vhdl-begin-fwd-re) |
| 6010 | (/= (preceding-char) ?_) |
| 6011 | (not (vhdl-in-literal)) |
| 6012 | (vhdl-begin-p lim)) |
| 6013 | (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) |
| 6014 | ;; If the current keyword is an "end" keyword, then find the |
| 6015 | ;; corresponding "begin" keyword. |
| 6016 | (if (and (setq begin-vec (vhdl-corresponding-begin lim)) |
| 6017 | (/= (preceding-char) ?_)) |
| 6018 | (let ( |
| 6019 | ;; begin-re is the statement keyword to search for |
| 6020 | (begin-re |
| 6021 | (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) |
| 6022 | ;; column is either the statement keyword target column |
| 6023 | ;; or nil |
| 6024 | (column (aref begin-vec 1)) |
| 6025 | ;; internal-p controls where the statement keyword can |
| 6026 | ;; be found. |
| 6027 | (internal-p (aref begin-vec 3)) |
| 6028 | (last-backward (point)) last-forward |
| 6029 | foundp literal keyword) |
| 6030 | ;; Look for the statement keyword. |
| 6031 | (while (and (not foundp) |
| 6032 | (re-search-backward begin-re lim t) |
| 6033 | (setq keyword |
| 6034 | (buffer-substring (match-beginning 1) |
| 6035 | (match-end 1)))) |
| 6036 | ;; If we are in a literal or in the wrong column, |
| 6037 | ;; then try again. |
| 6038 | (if (or (and column |
| 6039 | (and (/= (current-indentation) column) |
| 6040 | ;; possibly accept current-column as |
| 6041 | ;; well as current-indentation. |
| 6042 | (or (not internal-p) |
| 6043 | (/= (current-column) column)))) |
| 6044 | (= (preceding-char) ?_) |
| 6045 | (vhdl-in-literal)) |
| 6046 | (backward-char) |
| 6047 | ;; If there is a supplementary keyword, then |
| 6048 | ;; search forward for it. |
| 6049 | (if (and (setq begin-re (aref begin-vec 2)) |
| 6050 | (or (not (listp begin-re)) |
| 6051 | ;; If begin-re is an alist, then find the |
| 6052 | ;; element corresponding to the actual |
| 6053 | ;; keyword that we found. |
| 6054 | (progn |
| 6055 | (setq begin-re |
| 6056 | (assoc keyword begin-re)) |
| 6057 | (and begin-re |
| 6058 | (setq begin-re (cdr begin-re)))))) |
| 6059 | (and |
| 6060 | (setq begin-re |
| 6061 | (concat "\\b\\(" begin-re "\\)\\b[^_]")) |
| 6062 | (save-excursion |
| 6063 | (setq last-forward (point)) |
| 6064 | ;; Look for the supplementary keyword |
| 6065 | ;; (bounded by the backward search start |
| 6066 | ;; point). |
| 6067 | (while (and (not foundp) |
| 6068 | (re-search-forward begin-re |
| 6069 | last-backward t) |
| 6070 | (goto-char (match-beginning 1))) |
| 6071 | ;; If we are in a literal, then try again. |
| 6072 | (if (or (= (preceding-char) ?_) |
| 6073 | (setq literal |
| 6074 | (vhdl-in-literal))) |
| 6075 | (if (eq literal 'comment) |
| 6076 | (goto-char |
| 6077 | (min (vhdl-point 'eol) last-backward)) |
| 6078 | (forward-char)) |
| 6079 | ;; We have found the supplementary keyword. |
| 6080 | ;; Save the position of the keyword in foundp. |
| 6081 | (setq foundp (point))) |
| 6082 | ) |
| 6083 | foundp) |
| 6084 | ;; If the supplementary keyword was found, then |
| 6085 | ;; move point to the supplementary keyword. |
| 6086 | (goto-char foundp)) |
| 6087 | ;; If there was no supplementary keyword, then |
| 6088 | ;; point is already at the statement keyword. |
| 6089 | (setq foundp t))) |
| 6090 | ) ; end of the search for the statement keyword |
| 6091 | (if (not foundp) |
| 6092 | (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) |
| 6093 | )) |
| 6094 | (setq count (1- count)) |
| 6095 | ) |
| 6096 | (setq target (point))) |
| 6097 | (goto-char target) |
| 6098 | nil)) |
| 6099 | |
| 6100 | (defun vhdl-backward-up-list (&optional count limit) |
| 6101 | "Move backward out of one level of blocks. |
| 6102 | With argument, do this that many times." |
| 6103 | (interactive "p") |
| 6104 | (let ((count (or count 1)) |
| 6105 | target) |
| 6106 | (save-excursion |
| 6107 | (while (> count 0) |
| 6108 | (if (looking-at vhdl-defun-re) |
| 6109 | (error "ERROR: Unbalanced blocks")) |
| 6110 | (vhdl-backward-to-block limit) |
| 6111 | (setq count (1- count))) |
| 6112 | (setq target (point))) |
| 6113 | (goto-char target))) |
| 6114 | |
| 6115 | (defun vhdl-end-of-defun (&optional count) |
| 6116 | "Move forward to the end of a VHDL defun." |
| 6117 | (interactive) |
| 6118 | (let ((case-fold-search t)) |
| 6119 | (vhdl-beginning-of-defun) |
| 6120 | (if (not (looking-at "block\\|process\\|procedural")) |
| 6121 | (re-search-forward "\\bis\\b")) |
| 6122 | (vhdl-forward-sexp))) |
| 6123 | |
| 6124 | (defun vhdl-mark-defun () |
| 6125 | "Put mark at end of this \"defun\", point at beginning." |
| 6126 | (interactive) |
| 6127 | (let ((case-fold-search t)) |
| 6128 | (push-mark) |
| 6129 | (vhdl-beginning-of-defun) |
| 6130 | (push-mark) |
| 6131 | (if (not (looking-at "block\\|process\\|procedural")) |
| 6132 | (re-search-forward "\\bis\\b")) |
| 6133 | (vhdl-forward-sexp) |
| 6134 | (exchange-point-and-mark))) |
| 6135 | |
| 6136 | (defun vhdl-beginning-of-libunit () |
| 6137 | "Move backward to the beginning of a VHDL library unit. |
| 6138 | Returns the location of the corresponding begin keyword, unless search |
| 6139 | stops due to beginning or end of buffer. |
| 6140 | Note that if point is between the \"libunit\" keyword and the |
| 6141 | corresponding \"begin\" keyword, then that libunit will not be |
| 6142 | recognized, and the search will continue backwards. If point is |
| 6143 | at the \"begin\" keyword, then the defun will be recognized. The |
| 6144 | returned point is at the first character of the \"libunit\" keyword." |
| 6145 | (let ((last-forward (point)) |
| 6146 | (last-backward |
| 6147 | ;; Just in case we are actually sitting on the "begin" |
| 6148 | ;; keyword, allow for the keyword and an extra character, |
| 6149 | ;; as this will be used when looking forward for the |
| 6150 | ;; "begin" keyword. |
| 6151 | (save-excursion (forward-word 1) (1+ (point)))) |
| 6152 | foundp literal placeholder) |
| 6153 | ;; Find the "libunit" keyword. |
| 6154 | (while (and (not foundp) |
| 6155 | (re-search-backward vhdl-libunit-re nil 'move)) |
| 6156 | ;; If we are in a literal, or not at a real libunit, then try again. |
| 6157 | (if (or (= (preceding-char) ?_) |
| 6158 | (vhdl-in-literal) |
| 6159 | (not (vhdl-libunit-p))) |
| 6160 | (backward-char) |
| 6161 | ;; Find the corresponding "begin" keyword. |
| 6162 | (setq last-forward (point)) |
| 6163 | (while (and (not foundp) |
| 6164 | (re-search-forward "\\bis\\b[^_]" last-backward t) |
| 6165 | (setq placeholder (match-beginning 0))) |
| 6166 | (if (or (= (preceding-char) ?_) |
| 6167 | (setq literal (vhdl-in-literal))) |
| 6168 | ;; It wasn't a real keyword, so keep searching. |
| 6169 | (if (eq literal 'comment) |
| 6170 | (goto-char |
| 6171 | (min (vhdl-point 'eol) last-backward)) |
| 6172 | (forward-char)) |
| 6173 | ;; We have found the begin keyword, loop will exit. |
| 6174 | (setq foundp placeholder))) |
| 6175 | ;; Go back to the libunit keyword |
| 6176 | (goto-char last-forward))) |
| 6177 | foundp)) |
| 6178 | |
| 6179 | (defun vhdl-beginning-of-defun (&optional count) |
| 6180 | "Move backward to the beginning of a VHDL defun. |
| 6181 | With argument, do it that many times. |
| 6182 | Returns the location of the corresponding begin keyword, unless search |
| 6183 | stops due to beginning or end of buffer." |
| 6184 | ;; Note that if point is between the "defun" keyword and the |
| 6185 | ;; corresponding "begin" keyword, then that defun will not be |
| 6186 | ;; recognized, and the search will continue backwards. If point is |
| 6187 | ;; at the "begin" keyword, then the defun will be recognized. The |
| 6188 | ;; returned point is at the first character of the "defun" keyword. |
| 6189 | (interactive "p") |
| 6190 | (let ((count (or count 1)) |
| 6191 | (case-fold-search t) |
| 6192 | (last-forward (point)) |
| 6193 | foundp) |
| 6194 | (while (> count 0) |
| 6195 | (setq foundp nil) |
| 6196 | (goto-char last-forward) |
| 6197 | (let ((last-backward |
| 6198 | ;; Just in case we are actually sitting on the "begin" |
| 6199 | ;; keyword, allow for the keyword and an extra character, |
| 6200 | ;; as this will be used when looking forward for the |
| 6201 | ;; "begin" keyword. |
| 6202 | (save-excursion (forward-word 1) (1+ (point)))) |
| 6203 | begin-string literal) |
| 6204 | (while (and (not foundp) |
| 6205 | (re-search-backward vhdl-defun-re nil 'move)) |
| 6206 | ;; If we are in a literal, then try again. |
| 6207 | (if (or (= (preceding-char) ?_) |
| 6208 | (vhdl-in-literal)) |
| 6209 | (backward-char) |
| 6210 | (if (setq begin-string (vhdl-corresponding-defun)) |
| 6211 | ;; This is a real defun keyword. |
| 6212 | ;; Find the corresponding "begin" keyword. |
| 6213 | ;; Look for the begin keyword. |
| 6214 | (progn |
| 6215 | ;; Save the search start point. |
| 6216 | (setq last-forward (point)) |
| 6217 | (while (and (not foundp) |
| 6218 | (search-forward begin-string last-backward t)) |
| 6219 | (if (or (= (preceding-char) ?_) |
| 6220 | (save-match-data |
| 6221 | (setq literal (vhdl-in-literal)))) |
| 6222 | ;; It wasn't a real keyword, so keep searching. |
| 6223 | (if (eq literal 'comment) |
| 6224 | (goto-char |
| 6225 | (min (vhdl-point 'eol) last-backward)) |
| 6226 | (forward-char)) |
| 6227 | ;; We have found the begin keyword, loop will exit. |
| 6228 | (setq foundp (match-beginning 0))) |
| 6229 | ) |
| 6230 | ;; Go back to the defun keyword |
| 6231 | (goto-char last-forward)) ; end search for begin keyword |
| 6232 | )) |
| 6233 | ) ; end of the search for the defun keyword |
| 6234 | ) |
| 6235 | (setq count (1- count)) |
| 6236 | ) |
| 6237 | (vhdl-keep-region-active) |
| 6238 | foundp)) |
| 6239 | |
| 6240 | (defun vhdl-beginning-of-statement (&optional count lim interactive) |
| 6241 | "Go to the beginning of the innermost VHDL statement. |
| 6242 | With prefix arg, go back N - 1 statements. If already at the |
| 6243 | beginning of a statement then go to the beginning of the preceding |
| 6244 | one. If within a string or comment, or next to a comment (only |
| 6245 | whitespace between), move by sentences instead of statements. |
| 6246 | |
| 6247 | When called from a program, this function takes 3 optional args: the |
| 6248 | prefix arg, a buffer position limit which is the farthest back to |
| 6249 | search, and an argument indicating an interactive call." |
| 6250 | (interactive "p\np") |
| 6251 | (let ((count (or count 1)) |
| 6252 | (case-fold-search t) |
| 6253 | (lim (or lim (point-min))) |
| 6254 | (here (point)) |
| 6255 | state) |
| 6256 | (save-excursion |
| 6257 | (goto-char lim) |
| 6258 | (setq state (parse-partial-sexp (point) here nil nil))) |
| 6259 | (if (and interactive |
| 6260 | (or (nth 3 state) |
| 6261 | (nth 4 state) |
| 6262 | (looking-at (concat "[ \t]*" comment-start-skip)))) |
| 6263 | (forward-sentence (- count)) |
| 6264 | (while (> count 0) |
| 6265 | (vhdl-beginning-of-statement-1 lim) |
| 6266 | (setq count (1- count)))) |
| 6267 | ;; its possible we've been left up-buf of lim |
| 6268 | (goto-char (max (point) lim)) |
| 6269 | ) |
| 6270 | (vhdl-keep-region-active)) |
| 6271 | |
| 6272 | (defconst vhdl-e-o-s-re |
| 6273 | (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) |
| 6274 | |
| 6275 | (defun vhdl-end-of-statement () |
| 6276 | "Very simple implementation." |
| 6277 | (interactive) |
| 6278 | (re-search-forward vhdl-e-o-s-re)) |
| 6279 | |
| 6280 | (defconst vhdl-b-o-s-re |
| 6281 | (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|" |
| 6282 | vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) |
| 6283 | |
| 6284 | (defun vhdl-beginning-of-statement-1 (&optional lim) |
| 6285 | "Move to the start of the current statement, or the previous |
| 6286 | statement if already at the beginning of one." |
| 6287 | (let ((lim (or lim (point-min))) |
| 6288 | (here (point)) |
| 6289 | (pos (point)) |
| 6290 | donep) |
| 6291 | ;; go backwards one balanced expression, but be careful of |
| 6292 | ;; unbalanced paren being reached |
| 6293 | (if (not (vhdl-safe (progn (backward-sexp) t))) |
| 6294 | (progn |
| 6295 | (backward-up-list 1) |
| 6296 | (forward-char) |
| 6297 | (vhdl-forward-syntactic-ws here) |
| 6298 | (setq donep t))) |
| 6299 | (while (and (not donep) |
| 6300 | (not (bobp)) |
| 6301 | ;; look backwards for a statement boundary |
| 6302 | (re-search-backward vhdl-b-o-s-re lim 'move)) |
| 6303 | (if (or (= (preceding-char) ?_) |
| 6304 | (vhdl-in-literal)) |
| 6305 | (backward-char) |
| 6306 | (cond |
| 6307 | ;; If we are looking at an open paren, then stop after it |
| 6308 | ((eq (following-char) ?\() |
| 6309 | (forward-char) |
| 6310 | (vhdl-forward-syntactic-ws here) |
| 6311 | (setq donep t)) |
| 6312 | ;; If we are looking at a close paren, then skip it |
| 6313 | ((eq (following-char) ?\)) |
| 6314 | (forward-char) |
| 6315 | (setq pos (point)) |
| 6316 | (backward-sexp) |
| 6317 | (if (< (point) lim) |
| 6318 | (progn (goto-char pos) |
| 6319 | (vhdl-forward-syntactic-ws here) |
| 6320 | (setq donep t)))) |
| 6321 | ;; If we are looking at a semicolon, then stop |
| 6322 | ((eq (following-char) ?\;) |
| 6323 | (progn |
| 6324 | (forward-char) |
| 6325 | (vhdl-forward-syntactic-ws here) |
| 6326 | (setq donep t))) |
| 6327 | ;; If we are looking at a "begin", then stop |
| 6328 | ((and (looking-at vhdl-begin-fwd-re) |
| 6329 | (/= (preceding-char) ?_) |
| 6330 | (vhdl-begin-p nil)) |
| 6331 | ;; If it's a leader "begin", then find the |
| 6332 | ;; right place |
| 6333 | (if (looking-at vhdl-leader-re) |
| 6334 | (save-excursion |
| 6335 | ;; set a default stop point at the begin |
| 6336 | (setq pos (point)) |
| 6337 | ;; is the start point inside the leader area ? |
| 6338 | (goto-char (vhdl-end-of-leader)) |
| 6339 | (vhdl-forward-syntactic-ws here) |
| 6340 | (if (< (point) here) |
| 6341 | ;; start point was not inside leader area |
| 6342 | ;; set stop point at word after leader |
| 6343 | (setq pos (point)))) |
| 6344 | (forward-word 1) |
| 6345 | (vhdl-forward-syntactic-ws here) |
| 6346 | (setq pos (point))) |
| 6347 | (goto-char pos) |
| 6348 | (setq donep t)) |
| 6349 | ;; If we are looking at a "statement", then stop |
| 6350 | ((and (looking-at vhdl-statement-fwd-re) |
| 6351 | (/= (preceding-char) ?_) |
| 6352 | (vhdl-statement-p nil)) |
| 6353 | (setq donep t)) |
| 6354 | ;; If we are looking at a case alternative key, then stop |
| 6355 | ((and (looking-at vhdl-case-alternative-re) |
| 6356 | (vhdl-case-alternative-p lim)) |
| 6357 | (save-excursion |
| 6358 | ;; set a default stop point at the when |
| 6359 | (setq pos (point)) |
| 6360 | ;; is the start point inside the case alternative key ? |
| 6361 | (looking-at vhdl-case-alternative-re) |
| 6362 | (goto-char (match-end 0)) |
| 6363 | (vhdl-forward-syntactic-ws here) |
| 6364 | (if (< (point) here) |
| 6365 | ;; start point was not inside the case alternative key |
| 6366 | ;; set stop point at word after case alternative keyleader |
| 6367 | (setq pos (point)))) |
| 6368 | (goto-char pos) |
| 6369 | (setq donep t)) |
| 6370 | ;; Bogus find, continue |
| 6371 | (t |
| 6372 | (backward-char))))) |
| 6373 | )) |
| 6374 | |
| 6375 | ;; Defuns for calculating the current syntactic state: |
| 6376 | |
| 6377 | (defun vhdl-get-library-unit (bod placeholder) |
| 6378 | "If there is an enclosing library unit at BOD, with its \"begin\" |
| 6379 | keyword at PLACEHOLDER, then return the library unit type." |
| 6380 | (let ((here (vhdl-point 'bol))) |
| 6381 | (if (save-excursion |
| 6382 | (goto-char placeholder) |
| 6383 | (vhdl-safe (vhdl-forward-sexp 1 bod)) |
| 6384 | (<= here (point))) |
| 6385 | (save-excursion |
| 6386 | (goto-char bod) |
| 6387 | (cond |
| 6388 | ((looking-at "e") 'entity) |
| 6389 | ((looking-at "a") 'architecture) |
| 6390 | ((looking-at "c") 'configuration) |
| 6391 | ((looking-at "p") |
| 6392 | (save-excursion |
| 6393 | (goto-char bod) |
| 6394 | (forward-sexp) |
| 6395 | (vhdl-forward-syntactic-ws here) |
| 6396 | (if (looking-at "body\\b[^_]") |
| 6397 | 'package-body 'package)))))) |
| 6398 | )) |
| 6399 | |
| 6400 | (defun vhdl-get-block-state (&optional lim) |
| 6401 | "Finds and records all the closest opens. |
| 6402 | LIM is the furthest back we need to search (it should be the |
| 6403 | previous libunit keyword)." |
| 6404 | (let ((here (point)) |
| 6405 | (lim (or lim (point-min))) |
| 6406 | keyword sexp-start sexp-mid sexp-end |
| 6407 | preceding-sexp containing-sexp |
| 6408 | containing-begin containing-mid containing-paren) |
| 6409 | (save-excursion |
| 6410 | ;; Find the containing-paren, and use that as the limit |
| 6411 | (if (setq containing-paren |
| 6412 | (save-restriction |
| 6413 | (narrow-to-region lim (point)) |
| 6414 | (vhdl-safe (scan-lists (point) -1 1)))) |
| 6415 | (setq lim containing-paren)) |
| 6416 | ;; Look backwards for "begin" and "end" keywords. |
| 6417 | (while (and (> (point) lim) |
| 6418 | (not containing-sexp)) |
| 6419 | (setq keyword (vhdl-backward-to-block lim)) |
| 6420 | (cond |
| 6421 | ((eq keyword 'begin) |
| 6422 | ;; Found a "begin" keyword |
| 6423 | (setq sexp-start (point)) |
| 6424 | (setq sexp-mid (vhdl-corresponding-mid lim)) |
| 6425 | (setq sexp-end (vhdl-safe |
| 6426 | (save-excursion |
| 6427 | (vhdl-forward-sexp 1 lim) (point)))) |
| 6428 | (if (and sexp-end (<= sexp-end here)) |
| 6429 | ;; we want to record this sexp, but we only want to |
| 6430 | ;; record the last-most of any of them before here |
| 6431 | (or preceding-sexp |
| 6432 | (setq preceding-sexp sexp-start)) |
| 6433 | ;; we're contained in this sexp so put sexp-start on |
| 6434 | ;; front of list |
| 6435 | (setq containing-sexp sexp-start) |
| 6436 | (setq containing-mid sexp-mid) |
| 6437 | (setq containing-begin t))) |
| 6438 | ((eq keyword 'end) |
| 6439 | ;; Found an "end" keyword |
| 6440 | (forward-sexp) |
| 6441 | (setq sexp-end (point)) |
| 6442 | (setq sexp-mid nil) |
| 6443 | (setq sexp-start |
| 6444 | (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) |
| 6445 | (progn (backward-sexp) (point)))) |
| 6446 | ;; we want to record this sexp, but we only want to |
| 6447 | ;; record the last-most of any of them before here |
| 6448 | (or preceding-sexp |
| 6449 | (setq preceding-sexp sexp-start))) |
| 6450 | ))) |
| 6451 | ;; Check if the containing-paren should be the containing-sexp |
| 6452 | (if (and containing-paren |
| 6453 | (or (null containing-sexp) |
| 6454 | (< containing-sexp containing-paren))) |
| 6455 | (setq containing-sexp containing-paren |
| 6456 | preceding-sexp nil |
| 6457 | containing-begin nil |
| 6458 | containing-mid nil)) |
| 6459 | (vector containing-sexp preceding-sexp containing-begin containing-mid) |
| 6460 | )) |
| 6461 | |
| 6462 | |
| 6463 | (defconst vhdl-s-c-a-re |
| 6464 | (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) |
| 6465 | |
| 6466 | (defun vhdl-skip-case-alternative (&optional lim) |
| 6467 | "Skip forward over case/when bodies, with optional maximal |
| 6468 | limit. If no next case alternative is found, nil is returned and |
| 6469 | point is not moved." |
| 6470 | (let ((lim (or lim (point-max))) |
| 6471 | (here (point)) |
| 6472 | donep foundp) |
| 6473 | (while (and (< (point) lim) |
| 6474 | (not donep)) |
| 6475 | (if (and (re-search-forward vhdl-s-c-a-re lim 'move) |
| 6476 | (save-match-data |
| 6477 | (not (vhdl-in-literal))) |
| 6478 | (/= (match-beginning 0) here)) |
| 6479 | (progn |
| 6480 | (goto-char (match-beginning 0)) |
| 6481 | (cond |
| 6482 | ((and (looking-at "case") |
| 6483 | (re-search-forward "\\bis[^_]" lim t)) |
| 6484 | (backward-sexp) |
| 6485 | (vhdl-forward-sexp)) |
| 6486 | (t |
| 6487 | (setq donep t |
| 6488 | foundp t)))))) |
| 6489 | (if (not foundp) |
| 6490 | (goto-char here)) |
| 6491 | foundp)) |
| 6492 | |
| 6493 | (defun vhdl-backward-skip-label (&optional lim) |
| 6494 | "Skip backward over a label, with optional maximal |
| 6495 | limit. If label is not found, nil is returned and point |
| 6496 | is not moved." |
| 6497 | (let ((lim (or lim (point-min))) |
| 6498 | placeholder) |
| 6499 | (if (save-excursion |
| 6500 | (vhdl-backward-syntactic-ws lim) |
| 6501 | (and (eq (preceding-char) ?:) |
| 6502 | (progn |
| 6503 | (backward-sexp) |
| 6504 | (setq placeholder (point)) |
| 6505 | (looking-at vhdl-label-key)))) |
| 6506 | (goto-char placeholder)) |
| 6507 | )) |
| 6508 | |
| 6509 | (defun vhdl-forward-skip-label (&optional lim) |
| 6510 | "Skip forward over a label, with optional maximal |
| 6511 | limit. If label is not found, nil is returned and point |
| 6512 | is not moved." |
| 6513 | (let ((lim (or lim (point-max)))) |
| 6514 | (if (looking-at vhdl-label-key) |
| 6515 | (progn |
| 6516 | (goto-char (match-end 0)) |
| 6517 | (vhdl-forward-syntactic-ws lim))) |
| 6518 | )) |
| 6519 | |
| 6520 | (defun vhdl-get-syntactic-context () |
| 6521 | "Guess the syntactic description of the current line of VHDL code." |
| 6522 | (save-excursion |
| 6523 | (save-restriction |
| 6524 | (beginning-of-line) |
| 6525 | (let* ((indent-point (point)) |
| 6526 | (case-fold-search t) |
| 6527 | vec literal containing-sexp preceding-sexp |
| 6528 | containing-begin containing-mid containing-leader |
| 6529 | char-before-ip char-after-ip begin-after-ip end-after-ip |
| 6530 | placeholder lim library-unit |
| 6531 | ) |
| 6532 | |
| 6533 | ;; Reset the syntactic context |
| 6534 | (setq vhdl-syntactic-context nil) |
| 6535 | |
| 6536 | (save-excursion |
| 6537 | ;; Move to the start of the previous library unit, and |
| 6538 | ;; record the position of the "begin" keyword. |
| 6539 | (setq placeholder (vhdl-beginning-of-libunit)) |
| 6540 | ;; The position of the "libunit" keyword gives us a gross |
| 6541 | ;; limit point. |
| 6542 | (setq lim (point)) |
| 6543 | ) |
| 6544 | |
| 6545 | ;; If there is a previous library unit, and we are enclosed by |
| 6546 | ;; it, then set the syntax accordingly. |
| 6547 | (and placeholder |
| 6548 | (setq library-unit (vhdl-get-library-unit lim placeholder)) |
| 6549 | (vhdl-add-syntax library-unit lim)) |
| 6550 | |
| 6551 | ;; Find the surrounding state. |
| 6552 | (if (setq vec (vhdl-get-block-state lim)) |
| 6553 | (progn |
| 6554 | (setq containing-sexp (aref vec 0)) |
| 6555 | (setq preceding-sexp (aref vec 1)) |
| 6556 | (setq containing-begin (aref vec 2)) |
| 6557 | (setq containing-mid (aref vec 3)) |
| 6558 | )) |
| 6559 | |
| 6560 | ;; set the limit on the farthest back we need to search |
| 6561 | (setq lim (if containing-sexp |
| 6562 | (save-excursion |
| 6563 | (goto-char containing-sexp) |
| 6564 | ;; set containing-leader if required |
| 6565 | (if (looking-at vhdl-leader-re) |
| 6566 | (setq containing-leader (vhdl-end-of-leader))) |
| 6567 | (vhdl-point 'bol)) |
| 6568 | (point-min))) |
| 6569 | |
| 6570 | ;; cache char before and after indent point, and move point to |
| 6571 | ;; the most likely position to perform the majority of tests |
| 6572 | (goto-char indent-point) |
| 6573 | (skip-chars-forward " \t") |
| 6574 | (setq literal (vhdl-in-literal)) |
| 6575 | (setq char-after-ip (following-char)) |
| 6576 | (setq begin-after-ip (and |
| 6577 | (not literal) |
| 6578 | (looking-at vhdl-begin-fwd-re) |
| 6579 | (vhdl-begin-p))) |
| 6580 | (setq end-after-ip (and |
| 6581 | (not literal) |
| 6582 | (looking-at vhdl-end-fwd-re) |
| 6583 | (vhdl-end-p))) |
| 6584 | (vhdl-backward-syntactic-ws lim) |
| 6585 | (setq char-before-ip (preceding-char)) |
| 6586 | (goto-char indent-point) |
| 6587 | (skip-chars-forward " \t") |
| 6588 | |
| 6589 | ;; now figure out syntactic qualities of the current line |
| 6590 | (cond |
| 6591 | ;; CASE 1: in a string or comment. |
| 6592 | ((memq literal '(string comment)) |
| 6593 | (vhdl-add-syntax literal (vhdl-point 'bopl))) |
| 6594 | ;; CASE 2: Line is at top level. |
| 6595 | ((null containing-sexp) |
| 6596 | ;; Find the point to which indentation will be relative |
| 6597 | (save-excursion |
| 6598 | (if (null preceding-sexp) |
| 6599 | ;; CASE 2X.1 |
| 6600 | ;; no preceding-sexp -> use the preceding statement |
| 6601 | (vhdl-beginning-of-statement-1 lim) |
| 6602 | ;; CASE 2X.2 |
| 6603 | ;; if there is a preceding-sexp then indent relative to it |
| 6604 | (goto-char preceding-sexp) |
| 6605 | ;; if not at boi, then the block-opening keyword is |
| 6606 | ;; probably following a label, so we need a different |
| 6607 | ;; relpos |
| 6608 | (if (/= (point) (vhdl-point 'boi)) |
| 6609 | ;; CASE 2X.3 |
| 6610 | (vhdl-beginning-of-statement-1 lim))) |
| 6611 | ;; v-b-o-s could have left us at point-min |
| 6612 | (and (bobp) |
| 6613 | ;; CASE 2X.4 |
| 6614 | (vhdl-forward-syntactic-ws indent-point)) |
| 6615 | (setq placeholder (point))) |
| 6616 | (cond |
| 6617 | ;; CASE 2A : we are looking at a block-open |
| 6618 | (begin-after-ip |
| 6619 | (vhdl-add-syntax 'block-open placeholder)) |
| 6620 | ;; CASE 2B: we are looking at a block-close |
| 6621 | (end-after-ip |
| 6622 | (vhdl-add-syntax 'block-close placeholder)) |
| 6623 | ;; CASE 2C: we are looking at a top-level statement |
| 6624 | ((progn |
| 6625 | (vhdl-backward-syntactic-ws lim) |
| 6626 | (or (bobp) |
| 6627 | (= (preceding-char) ?\;))) |
| 6628 | (vhdl-add-syntax 'statement placeholder)) |
| 6629 | ;; CASE 2D: we are looking at a top-level statement-cont |
| 6630 | (t |
| 6631 | (vhdl-beginning-of-statement-1 lim) |
| 6632 | ;; v-b-o-s could have left us at point-min |
| 6633 | (and (bobp) |
| 6634 | ;; CASE 2D.1 |
| 6635 | (vhdl-forward-syntactic-ws indent-point)) |
| 6636 | (vhdl-add-syntax 'statement-cont (point))) |
| 6637 | )) ; end CASE 2 |
| 6638 | ;; CASE 3: line is inside parentheses. Most likely we are |
| 6639 | ;; either in a subprogram argument (interface) list, or a |
| 6640 | ;; continued expression containing parentheses. |
| 6641 | ((null containing-begin) |
| 6642 | (vhdl-backward-syntactic-ws containing-sexp) |
| 6643 | (cond |
| 6644 | ;; CASE 3A: we are looking at the arglist closing paren |
| 6645 | ((eq char-after-ip ?\)) |
| 6646 | (goto-char containing-sexp) |
| 6647 | (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) |
| 6648 | ;; CASE 3B: we are looking at the first argument in an empty |
| 6649 | ;; argument list. |
| 6650 | ((eq char-before-ip ?\() |
| 6651 | (goto-char containing-sexp) |
| 6652 | (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) |
| 6653 | ;; CASE 3C: we are looking at an arglist continuation line, |
| 6654 | ;; but the preceding argument is on the same line as the |
| 6655 | ;; opening paren. This case includes multi-line |
| 6656 | ;; expression paren groupings. |
| 6657 | ((and (save-excursion |
| 6658 | (goto-char (1+ containing-sexp)) |
| 6659 | (skip-chars-forward " \t") |
| 6660 | (not (eolp)) |
| 6661 | (not (looking-at "--"))) |
| 6662 | (save-excursion |
| 6663 | (vhdl-beginning-of-statement-1 containing-sexp) |
| 6664 | (skip-chars-backward " \t(") |
| 6665 | (<= (point) containing-sexp))) |
| 6666 | (goto-char containing-sexp) |
| 6667 | (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) |
| 6668 | ;; CASE 3D: we are looking at just a normal arglist |
| 6669 | ;; continuation line |
| 6670 | (t (vhdl-beginning-of-statement-1 containing-sexp) |
| 6671 | (vhdl-forward-syntactic-ws indent-point) |
| 6672 | (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) |
| 6673 | )) |
| 6674 | ;; CASE 4: A block mid open |
| 6675 | ((and begin-after-ip |
| 6676 | (looking-at containing-mid)) |
| 6677 | (goto-char containing-sexp) |
| 6678 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 6679 | (if (looking-at vhdl-trailer-re) |
| 6680 | ;; CASE 4.1 |
| 6681 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 6682 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 6683 | (vhdl-add-syntax 'block-open (point))) |
| 6684 | ;; CASE 5: block close brace |
| 6685 | (end-after-ip |
| 6686 | (goto-char containing-sexp) |
| 6687 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 6688 | (if (looking-at vhdl-trailer-re) |
| 6689 | ;; CASE 5.1 |
| 6690 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 6691 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 6692 | (vhdl-add-syntax 'block-close (point))) |
| 6693 | ;; CASE 6: A continued statement |
| 6694 | ((and (/= char-before-ip ?\;) |
| 6695 | ;; check it's not a trailer begin keyword, or a begin |
| 6696 | ;; keyword immediately following a label. |
| 6697 | (not (and begin-after-ip |
| 6698 | (or (looking-at vhdl-trailer-re) |
| 6699 | (save-excursion |
| 6700 | (vhdl-backward-skip-label containing-sexp))))) |
| 6701 | ;; check it's not a statement keyword |
| 6702 | (not (and (looking-at vhdl-statement-fwd-re) |
| 6703 | (vhdl-statement-p))) |
| 6704 | ;; see if the b-o-s is before the indent point |
| 6705 | (> indent-point |
| 6706 | (save-excursion |
| 6707 | (vhdl-beginning-of-statement-1 containing-sexp) |
| 6708 | ;; If we ended up after a leader, then this will |
| 6709 | ;; move us forward to the start of the first |
| 6710 | ;; statement. Note that a containing sexp here is |
| 6711 | ;; always a keyword, not a paren, so this will |
| 6712 | ;; have no effect if we hit the containing-sexp. |
| 6713 | (vhdl-forward-syntactic-ws indent-point) |
| 6714 | (setq placeholder (point)))) |
| 6715 | ;; check it's not a block-intro |
| 6716 | (/= placeholder containing-sexp) |
| 6717 | ;; check it's not a case block-intro |
| 6718 | (save-excursion |
| 6719 | (goto-char placeholder) |
| 6720 | (or (not (looking-at vhdl-case-alternative-re)) |
| 6721 | (> (match-end 0) indent-point)))) |
| 6722 | ;; Make placeholder skip a label, but only if it puts us |
| 6723 | ;; before the indent point at the start of a line. |
| 6724 | (let ((new placeholder)) |
| 6725 | (if (and (> indent-point |
| 6726 | (save-excursion |
| 6727 | (goto-char placeholder) |
| 6728 | (vhdl-forward-skip-label indent-point) |
| 6729 | (setq new (point)))) |
| 6730 | (save-excursion |
| 6731 | (goto-char new) |
| 6732 | (eq new (progn (back-to-indentation) (point))))) |
| 6733 | (setq placeholder new))) |
| 6734 | (vhdl-add-syntax 'statement-cont placeholder) |
| 6735 | (if begin-after-ip |
| 6736 | (vhdl-add-syntax 'block-open))) |
| 6737 | ;; Statement. But what kind? |
| 6738 | ;; CASE 7: A case alternative key |
| 6739 | ((and (looking-at vhdl-case-alternative-re) |
| 6740 | (vhdl-case-alternative-p containing-sexp)) |
| 6741 | ;; for a case alternative key, we set relpos to the first |
| 6742 | ;; non-whitespace char on the line containing the "case" |
| 6743 | ;; keyword. |
| 6744 | (goto-char containing-sexp) |
| 6745 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 6746 | (if (looking-at vhdl-trailer-re) |
| 6747 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 6748 | (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) |
| 6749 | ;; CASE 8: statement catchall |
| 6750 | (t |
| 6751 | ;; we know its a statement, but we need to find out if it is |
| 6752 | ;; the first statement in a block |
| 6753 | (if containing-leader |
| 6754 | (goto-char containing-leader) |
| 6755 | (goto-char containing-sexp) |
| 6756 | ;; Note that a containing sexp here is always a keyword, |
| 6757 | ;; not a paren, so skip over the keyword. |
| 6758 | (forward-sexp)) |
| 6759 | ;; move to the start of the first statement |
| 6760 | (vhdl-forward-syntactic-ws indent-point) |
| 6761 | (setq placeholder (point)) |
| 6762 | ;; we want to ignore case alternatives keys when skipping forward |
| 6763 | (let (incase-p) |
| 6764 | (while (looking-at vhdl-case-alternative-re) |
| 6765 | (setq incase-p (point)) |
| 6766 | ;; we also want to skip over the body of the |
| 6767 | ;; case/when statement if that doesn't put us at |
| 6768 | ;; after the indent-point |
| 6769 | (while (vhdl-skip-case-alternative indent-point)) |
| 6770 | ;; set up the match end |
| 6771 | (looking-at vhdl-case-alternative-re) |
| 6772 | (goto-char (match-end 0)) |
| 6773 | ;; move to the start of the first case alternative statement |
| 6774 | (vhdl-forward-syntactic-ws indent-point) |
| 6775 | (setq placeholder (point))) |
| 6776 | (cond |
| 6777 | ;; CASE 8A: we saw a case/when statement so we must be |
| 6778 | ;; in a switch statement. find out if we are at the |
| 6779 | ;; statement just after a case alternative key |
| 6780 | ((and incase-p |
| 6781 | (= (point) indent-point)) |
| 6782 | ;; relpos is the "when" keyword |
| 6783 | (vhdl-add-syntax 'statement-case-intro incase-p)) |
| 6784 | ;; CASE 8B: any old statement |
| 6785 | ((< (point) indent-point) |
| 6786 | ;; relpos is the first statement of the block |
| 6787 | (vhdl-add-syntax 'statement placeholder) |
| 6788 | (if begin-after-ip |
| 6789 | (vhdl-add-syntax 'block-open))) |
| 6790 | ;; CASE 8C: first statement in a block |
| 6791 | (t |
| 6792 | (goto-char containing-sexp) |
| 6793 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 6794 | (if (looking-at vhdl-trailer-re) |
| 6795 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 6796 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 6797 | (vhdl-add-syntax 'statement-block-intro (point)) |
| 6798 | (if begin-after-ip |
| 6799 | (vhdl-add-syntax 'block-open))) |
| 6800 | ))) |
| 6801 | ) |
| 6802 | |
| 6803 | ;; now we need to look at any modifiers |
| 6804 | (goto-char indent-point) |
| 6805 | (skip-chars-forward " \t") |
| 6806 | (if (looking-at "--") |
| 6807 | (vhdl-add-syntax 'comment)) |
| 6808 | (if (eq literal 'pound) |
| 6809 | (vhdl-add-syntax 'cpp-macro)) |
| 6810 | ;; return the syntax |
| 6811 | vhdl-syntactic-context)))) |
| 6812 | |
| 6813 | ;; Standard indentation line-ups: |
| 6814 | |
| 6815 | (defun vhdl-lineup-arglist (langelem) |
| 6816 | "Lineup the current arglist line with the arglist appearing just |
| 6817 | after the containing paren which starts the arglist." |
| 6818 | (save-excursion |
| 6819 | (let* ((containing-sexp |
| 6820 | (save-excursion |
| 6821 | ;; arglist-cont-nonempty gives relpos == |
| 6822 | ;; to boi of containing-sexp paren. This |
| 6823 | ;; is good when offset is +, but bad |
| 6824 | ;; when it is vhdl-lineup-arglist, so we |
| 6825 | ;; have to special case a kludge here. |
| 6826 | (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) |
| 6827 | (progn |
| 6828 | (beginning-of-line) |
| 6829 | (backward-up-list 1) |
| 6830 | (skip-chars-forward " \t" (vhdl-point 'eol))) |
| 6831 | (goto-char (cdr langelem))) |
| 6832 | (point))) |
| 6833 | (cs-curcol (save-excursion |
| 6834 | (goto-char (cdr langelem)) |
| 6835 | (current-column)))) |
| 6836 | (if (save-excursion |
| 6837 | (beginning-of-line) |
| 6838 | (looking-at "[ \t]*)")) |
| 6839 | (progn (goto-char (match-end 0)) |
| 6840 | (backward-sexp) |
| 6841 | (forward-char) |
| 6842 | (vhdl-forward-syntactic-ws) |
| 6843 | (- (current-column) cs-curcol)) |
| 6844 | (goto-char containing-sexp) |
| 6845 | (or (eolp) |
| 6846 | (let ((eol (vhdl-point 'eol)) |
| 6847 | (here (progn |
| 6848 | (forward-char) |
| 6849 | (skip-chars-forward " \t") |
| 6850 | (point)))) |
| 6851 | (vhdl-forward-syntactic-ws) |
| 6852 | (if (< (point) eol) |
| 6853 | (goto-char here)))) |
| 6854 | (- (current-column) cs-curcol) |
| 6855 | )))) |
| 6856 | |
| 6857 | (defun vhdl-lineup-arglist-intro (langelem) |
| 6858 | "Lineup an arglist-intro line to just after the open paren." |
| 6859 | (save-excursion |
| 6860 | (let ((cs-curcol (save-excursion |
| 6861 | (goto-char (cdr langelem)) |
| 6862 | (current-column))) |
| 6863 | (ce-curcol (save-excursion |
| 6864 | (beginning-of-line) |
| 6865 | (backward-up-list 1) |
| 6866 | (skip-chars-forward " \t" (vhdl-point 'eol)) |
| 6867 | (current-column)))) |
| 6868 | (- ce-curcol cs-curcol -1)))) |
| 6869 | |
| 6870 | (defun vhdl-lineup-comment (langelem) |
| 6871 | "Support old behavior for comment indentation. We look at |
| 6872 | vhdl-comment-only-line-offset to decide how to indent comment |
| 6873 | only-lines." |
| 6874 | (save-excursion |
| 6875 | (back-to-indentation) |
| 6876 | ;; at or to the right of comment-column |
| 6877 | (if (>= (current-column) comment-column) |
| 6878 | (vhdl-comment-indent) |
| 6879 | ;; otherwise, indent as specified by vhdl-comment-only-line-offset |
| 6880 | (if (not (bolp)) |
| 6881 | (or (car-safe vhdl-comment-only-line-offset) |
| 6882 | vhdl-comment-only-line-offset) |
| 6883 | (or (cdr-safe vhdl-comment-only-line-offset) |
| 6884 | (car-safe vhdl-comment-only-line-offset) |
| 6885 | -1000 ;jam it against the left side |
| 6886 | ))))) |
| 6887 | |
| 6888 | (defun vhdl-lineup-statement-cont (langelem) |
| 6889 | "Line up statement-cont after the assignment operator." |
| 6890 | (save-excursion |
| 6891 | (let* ((relpos (cdr langelem)) |
| 6892 | (assignp (save-excursion |
| 6893 | (goto-char (vhdl-point 'boi)) |
| 6894 | (and (re-search-forward "\\(<\\|:\\)=" |
| 6895 | (vhdl-point 'eol) t) |
| 6896 | (- (point) (vhdl-point 'boi))))) |
| 6897 | (curcol (progn |
| 6898 | (goto-char relpos) |
| 6899 | (current-column))) |
| 6900 | foundp) |
| 6901 | (while (and (not foundp) |
| 6902 | (< (point) (vhdl-point 'eol))) |
| 6903 | (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move) |
| 6904 | (if (vhdl-in-literal) |
| 6905 | (forward-char) |
| 6906 | (if (= (preceding-char) ?\() |
| 6907 | ;; skip over any parenthesized expressions |
| 6908 | (goto-char (min (vhdl-point 'eol) |
| 6909 | (scan-lists (point) 1 1))) |
| 6910 | ;; found an assignment operator (not at eol) |
| 6911 | (setq foundp (not (looking-at "\\s-*$")))))) |
| 6912 | (if (not foundp) |
| 6913 | ;; there's no assignment operator on the line |
| 6914 | vhdl-basic-offset |
| 6915 | ;; calculate indentation column after assign and ws, unless |
| 6916 | ;; our line contains an assignment operator |
| 6917 | (if (not assignp) |
| 6918 | (progn |
| 6919 | (forward-char) |
| 6920 | (skip-chars-forward " \t") |
| 6921 | (setq assignp 0))) |
| 6922 | (- (current-column) assignp curcol)) |
| 6923 | ))) |
| 6924 | |
| 6925 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 6926 | ;; Progress reporting |
| 6927 | |
| 6928 | (defvar vhdl-progress-info nil |
| 6929 | "Array variable for progress information: 0 begin, 1 end, 2 time.") |
| 6930 | |
| 6931 | (defun vhdl-update-progress-info (string pos) |
| 6932 | "Update progress information." |
| 6933 | (when (and vhdl-progress-info (not noninteractive) |
| 6934 | (< vhdl-progress-interval |
| 6935 | (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) |
| 6936 | (let ((delta (- (aref vhdl-progress-info 1) |
| 6937 | (aref vhdl-progress-info 0)))) |
| 6938 | (if (= 0 delta) |
| 6939 | (message (concat string "... (100%s)") "%") |
| 6940 | (message (concat string "... (%2d%s)") |
| 6941 | (/ (* 100 (- pos (aref vhdl-progress-info 0))) |
| 6942 | delta) "%"))) |
| 6943 | (aset vhdl-progress-info 2 (nth 1 (current-time))))) |
| 6944 | |
| 6945 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 6946 | ;; Indentation commands |
| 6947 | |
| 6948 | (defun vhdl-electric-tab (&optional prefix-arg) |
| 6949 | "If preceding character is part of a word or a paren then hippie-expand, |
| 6950 | else if right of non whitespace on line then insert tab, |
| 6951 | else if last command was a tab or return then dedent one step or if a comment |
| 6952 | toggle between normal indent and inline comment indent, |
| 6953 | else indent `correctly'." |
| 6954 | (interactive "*P") |
| 6955 | (vhdl-prepare-search-2 |
| 6956 | (cond |
| 6957 | ;; indent region if region is active |
| 6958 | ((and (not (featurep 'xemacs)) (use-region-p)) |
| 6959 | (vhdl-indent-region (region-beginning) (region-end) nil)) |
| 6960 | ;; expand word |
| 6961 | ((= (char-syntax (preceding-char)) ?w) |
| 6962 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 6963 | (case-replace nil) |
| 6964 | (hippie-expand-only-buffers |
| 6965 | (or (and (boundp 'hippie-expand-only-buffers) |
| 6966 | hippie-expand-only-buffers) |
| 6967 | '(vhdl-mode)))) |
| 6968 | (vhdl-expand-abbrev prefix-arg))) |
| 6969 | ;; expand parenthesis |
| 6970 | ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) |
| 6971 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 6972 | (case-replace nil)) |
| 6973 | (vhdl-expand-paren prefix-arg))) |
| 6974 | ;; insert tab |
| 6975 | ((> (current-column) (current-indentation)) |
| 6976 | (insert-tab)) |
| 6977 | ;; toggle comment indent |
| 6978 | ((and (looking-at "--") |
| 6979 | (or (eq last-command 'vhdl-electric-tab) |
| 6980 | (eq last-command 'vhdl-electric-return))) |
| 6981 | (cond ((= (current-indentation) 0) ; no indent |
| 6982 | (indent-to 1) |
| 6983 | (indent-according-to-mode)) |
| 6984 | ((< (current-indentation) comment-column) ; normal indent |
| 6985 | (indent-to comment-column) |
| 6986 | (indent-according-to-mode)) |
| 6987 | (t ; inline comment indent |
| 6988 | (delete-region (line-beginning-position) (point))))) |
| 6989 | ;; dedent |
| 6990 | ((and (>= (current-indentation) vhdl-basic-offset) |
| 6991 | (or (eq last-command 'vhdl-electric-tab) |
| 6992 | (eq last-command 'vhdl-electric-return))) |
| 6993 | (backward-delete-char-untabify vhdl-basic-offset nil)) |
| 6994 | ;; indent line |
| 6995 | (t (indent-according-to-mode))) |
| 6996 | (setq this-command 'vhdl-electric-tab))) |
| 6997 | |
| 6998 | (defun vhdl-electric-return () |
| 6999 | "newline-and-indent or indent-new-comment-line if in comment and preceding |
| 7000 | character is a space." |
| 7001 | (interactive) |
| 7002 | (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) |
| 7003 | (indent-new-comment-line) |
| 7004 | (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) |
| 7005 | (vhdl-fix-case-word -1)) |
| 7006 | (newline-and-indent))) |
| 7007 | |
| 7008 | (defun vhdl-indent-line () |
| 7009 | "Indent the current line as VHDL code. Returns the amount of |
| 7010 | indentation change." |
| 7011 | (interactive) |
| 7012 | (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) |
| 7013 | (pos (- (point-max) (point))) |
| 7014 | (indent |
| 7015 | (if syntax |
| 7016 | ;; indent syntax-based |
| 7017 | (if (and (eq (caar syntax) 'comment) |
| 7018 | (>= (vhdl-get-offset (car syntax)) comment-column)) |
| 7019 | ;; special case: comments at or right of comment-column |
| 7020 | (vhdl-get-offset (car syntax)) |
| 7021 | (apply '+ (mapcar 'vhdl-get-offset syntax))) |
| 7022 | ;; indent like previous nonblank line |
| 7023 | (save-excursion (beginning-of-line) |
| 7024 | (re-search-backward "^[^\n]" nil t) |
| 7025 | (current-indentation)))) |
| 7026 | (shift-amt (- indent (current-indentation)))) |
| 7027 | (and vhdl-echo-syntactic-information-p |
| 7028 | (message "syntax: %s, indent= %d" syntax indent)) |
| 7029 | (unless (zerop shift-amt) |
| 7030 | (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) |
| 7031 | (beginning-of-line) |
| 7032 | (indent-to indent)) |
| 7033 | (if (< (point) (vhdl-point 'boi)) |
| 7034 | (back-to-indentation) |
| 7035 | ;; If initial point was within line's indentation, position after |
| 7036 | ;; the indentation. Else stay at same point in text. |
| 7037 | (when (> (- (point-max) pos) (point)) |
| 7038 | (goto-char (- (point-max) pos)))) |
| 7039 | (run-hooks 'vhdl-special-indent-hook) |
| 7040 | (vhdl-update-progress-info "Indenting" (vhdl-current-line)) |
| 7041 | shift-amt)) |
| 7042 | |
| 7043 | (defun vhdl-indent-region (beg end column) |
| 7044 | "Indent region as VHDL code. |
| 7045 | Adds progress reporting to `indent-region'." |
| 7046 | (interactive "r\nP") |
| 7047 | (when vhdl-progress-interval |
| 7048 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7049 | (count-lines (point-min) end) 0))) |
| 7050 | (indent-region beg end column) |
| 7051 | (when vhdl-progress-interval (message "Indenting...done")) |
| 7052 | (setq vhdl-progress-info nil)) |
| 7053 | |
| 7054 | (defun vhdl-indent-buffer () |
| 7055 | "Indent whole buffer as VHDL code. |
| 7056 | Calls `indent-region' for whole buffer and adds progress reporting." |
| 7057 | (interactive) |
| 7058 | (vhdl-indent-region (point-min) (point-max) nil)) |
| 7059 | |
| 7060 | (defun vhdl-indent-group () |
| 7061 | "Indent group of lines between empty lines." |
| 7062 | (interactive) |
| 7063 | (let ((beg (save-excursion |
| 7064 | (if (re-search-backward vhdl-align-group-separate nil t) |
| 7065 | (point-marker) |
| 7066 | (point-min-marker)))) |
| 7067 | (end (save-excursion |
| 7068 | (if (re-search-forward vhdl-align-group-separate nil t) |
| 7069 | (point-marker) |
| 7070 | (point-max-marker))))) |
| 7071 | (vhdl-indent-region beg end nil))) |
| 7072 | |
| 7073 | (defun vhdl-indent-sexp (&optional endpos) |
| 7074 | "Indent each line of the list starting just after point. |
| 7075 | If optional arg ENDPOS is given, indent each line, stopping when |
| 7076 | ENDPOS is encountered." |
| 7077 | (interactive) |
| 7078 | (save-excursion |
| 7079 | (let ((beg (point)) |
| 7080 | (end (progn (vhdl-forward-sexp nil endpos) (point)))) |
| 7081 | (indent-region beg end nil)))) |
| 7082 | |
| 7083 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7084 | ;; Miscellaneous commands |
| 7085 | |
| 7086 | (defun vhdl-show-syntactic-information () |
| 7087 | "Show syntactic information for current line." |
| 7088 | (interactive) |
| 7089 | (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) |
| 7090 | (vhdl-keep-region-active)) |
| 7091 | |
| 7092 | ;; Verification and regression functions: |
| 7093 | |
| 7094 | (defun vhdl-regress-line (&optional arg) |
| 7095 | "Check syntactic information for current line." |
| 7096 | (interactive "P") |
| 7097 | (let ((expected (save-excursion |
| 7098 | (end-of-line) |
| 7099 | (when (search-backward " -- ((" (vhdl-point 'bol) t) |
| 7100 | (forward-char 4) |
| 7101 | (read (current-buffer))))) |
| 7102 | (actual (vhdl-get-syntactic-context)) |
| 7103 | (expurgated)) |
| 7104 | ;; remove the library unit symbols |
| 7105 | (mapc |
| 7106 | (function |
| 7107 | (lambda (elt) |
| 7108 | (if (memq (car elt) '(entity configuration package |
| 7109 | package-body architecture)) |
| 7110 | nil |
| 7111 | (setq expurgated (append expurgated (list elt)))))) |
| 7112 | actual) |
| 7113 | (if (and (not arg) expected (listp expected)) |
| 7114 | (if (not (equal expected expurgated)) |
| 7115 | (error "ERROR: Should be: %s, is: %s" expected expurgated)) |
| 7116 | (save-excursion |
| 7117 | (beginning-of-line) |
| 7118 | (when (not (looking-at "^\\s-*\\(--.*\\)?$")) |
| 7119 | (end-of-line) |
| 7120 | (if (search-backward " -- ((" (vhdl-point 'bol) t) |
| 7121 | (delete-region (point) (line-end-position))) |
| 7122 | (insert " -- ") |
| 7123 | (insert (format "%s" expurgated)))))) |
| 7124 | (vhdl-keep-region-active)) |
| 7125 | |
| 7126 | |
| 7127 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7128 | ;;; Alignment, whitespace fixup, beautifying |
| 7129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7130 | |
| 7131 | (defconst vhdl-align-alist |
| 7132 | '( |
| 7133 | ;; after some keywords |
| 7134 | (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]" |
| 7135 | "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2) |
| 7136 | ;; before ':' |
| 7137 | (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") |
| 7138 | ;; after direction specifications |
| 7139 | (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" |
| 7140 | ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) |
| 7141 | ;; before "==", ":=", "=>", and "<=" |
| 7142 | (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur |
| 7143 | (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) |
| 7144 | (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur |
| 7145 | ;; before some keywords |
| 7146 | (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) |
| 7147 | (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) |
| 7148 | (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) |
| 7149 | ;; before "=>" since "when/else ... =>" can occur |
| 7150 | (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) |
| 7151 | ) |
| 7152 | "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). |
| 7153 | It is searched in order. If REGEXP is found anywhere in the first |
| 7154 | line of a region to be aligned, ALIGN-PATTERN will be used for that |
| 7155 | region. ALIGN-PATTERN must include the whitespace to be expanded or |
| 7156 | contracted. It may also provide regexps for the text surrounding the |
| 7157 | whitespace. SUBEXP specifies which sub-expression of |
| 7158 | ALIGN-PATTERN matches the white space to be expanded/contracted.") |
| 7159 | |
| 7160 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7161 | ;; Align code |
| 7162 | |
| 7163 | (defvar vhdl-align-try-all-clauses t |
| 7164 | "If REGEXP is not found on the first line of the region that clause |
| 7165 | is ignored. If this variable is non-nil, then the clause is tried anyway.") |
| 7166 | |
| 7167 | (defun vhdl-do-group (function &optional spacing) |
| 7168 | "Apply FUNCTION on group of lines between empty lines." |
| 7169 | (let |
| 7170 | ;; search for group beginning |
| 7171 | ((beg (save-excursion |
| 7172 | (if (re-search-backward vhdl-align-group-separate nil t) |
| 7173 | (progn (beginning-of-line 2) (back-to-indentation) (point)) |
| 7174 | (point-min)))) |
| 7175 | ;; search for group end |
| 7176 | (end (save-excursion |
| 7177 | (if (re-search-forward vhdl-align-group-separate nil t) |
| 7178 | (progn (beginning-of-line) (point)) |
| 7179 | (point-max))))) |
| 7180 | ;; run FUNCTION |
| 7181 | (funcall function beg end spacing))) |
| 7182 | |
| 7183 | (defun vhdl-do-list (function &optional spacing) |
| 7184 | "Apply FUNCTION to the lines of a list surrounded by a balanced group of |
| 7185 | parentheses." |
| 7186 | (let (beg end) |
| 7187 | (save-excursion |
| 7188 | ;; search for beginning of balanced group of parentheses |
| 7189 | (setq beg (vhdl-re-search-backward "[()]" nil t)) |
| 7190 | (while (looking-at ")") |
| 7191 | (forward-char) (backward-sexp) |
| 7192 | (setq beg (vhdl-re-search-backward "[()]" nil t))) |
| 7193 | ;; search for end of balanced group of parentheses |
| 7194 | (when beg |
| 7195 | (forward-list) |
| 7196 | (setq end (point)) |
| 7197 | (goto-char (1+ beg)) |
| 7198 | (skip-chars-forward " \t\n") |
| 7199 | (setq beg (point)))) |
| 7200 | ;; run FUNCTION |
| 7201 | (if beg |
| 7202 | (funcall function beg end spacing) |
| 7203 | (error "ERROR: Not within a list enclosed by a pair of parentheses")))) |
| 7204 | |
| 7205 | (defun vhdl-do-same-indent (function &optional spacing) |
| 7206 | "Apply FUNCTION to block of lines with same indent." |
| 7207 | (let ((indent (current-indentation)) |
| 7208 | beg end) |
| 7209 | ;; search for first line with same indent |
| 7210 | (save-excursion |
| 7211 | (while (and (not (bobp)) |
| 7212 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7213 | (= (current-indentation) indent))) |
| 7214 | (unless (looking-at "^\\s-*$") |
| 7215 | (back-to-indentation) (setq beg (point))) |
| 7216 | (beginning-of-line -0))) |
| 7217 | ;; search for last line with same indent |
| 7218 | (save-excursion |
| 7219 | (while (and (not (eobp)) |
| 7220 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7221 | (= (current-indentation) indent))) |
| 7222 | (if (looking-at "^\\s-*$") |
| 7223 | (beginning-of-line 2) |
| 7224 | (beginning-of-line 2) |
| 7225 | (setq end (point))))) |
| 7226 | ;; run FUNCTION |
| 7227 | (funcall function beg end spacing))) |
| 7228 | |
| 7229 | (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) |
| 7230 | "Attempt to align a range of lines based on the content of the |
| 7231 | lines. The definition of `alignment-list' determines the matching |
| 7232 | order and the manner in which the lines are aligned. If ALIGNMENT-LIST |
| 7233 | is not specified `vhdl-align-alist' is used. If INDENT is non-nil, |
| 7234 | indentation is done before aligning." |
| 7235 | (interactive "r\np") |
| 7236 | (setq alignment-list (or alignment-list vhdl-align-alist)) |
| 7237 | (setq spacing (or spacing 1)) |
| 7238 | (save-excursion |
| 7239 | (let (bol indent) |
| 7240 | (goto-char end) |
| 7241 | (setq end (point-marker)) |
| 7242 | (goto-char begin) |
| 7243 | (setq bol (setq begin (progn (beginning-of-line) (point)))) |
| 7244 | ; (untabify bol end) |
| 7245 | (when indent |
| 7246 | (indent-region bol end nil)))) |
| 7247 | (let ((copy (copy-alist alignment-list))) |
| 7248 | (vhdl-prepare-search-2 |
| 7249 | (while copy |
| 7250 | (save-excursion |
| 7251 | (goto-char begin) |
| 7252 | (let (element |
| 7253 | (eol (point-at-eol))) |
| 7254 | (setq element (nth 0 copy)) |
| 7255 | (when (and (or (and (listp (car element)) |
| 7256 | (memq major-mode (car element))) |
| 7257 | (eq major-mode (car element))) |
| 7258 | (or vhdl-align-try-all-clauses |
| 7259 | (re-search-forward (car (cdr element)) eol t))) |
| 7260 | (vhdl-align-region-2 begin end (car (cdr (cdr element))) |
| 7261 | (car (cdr (cdr (cdr element)))) spacing)) |
| 7262 | (setq copy (cdr copy)))))))) |
| 7263 | |
| 7264 | (defun vhdl-align-region-2 (begin end match &optional substr spacing) |
| 7265 | "Align a range of lines from BEGIN to END. The regular expression |
| 7266 | MATCH must match exactly one field: the whitespace to be |
| 7267 | contracted/expanded. The alignment column will equal the |
| 7268 | rightmost column of the widest whitespace block. SPACING is |
| 7269 | the amount of extra spaces to add to the calculated maximum required. |
| 7270 | SPACING defaults to 1 so that at least one space is inserted after |
| 7271 | the token in MATCH." |
| 7272 | (setq spacing (or spacing 1)) |
| 7273 | (setq substr (or substr 1)) |
| 7274 | (save-excursion |
| 7275 | (let (distance (max 0) (lines 0) bol eol width) |
| 7276 | ;; Determine the greatest whitespace distance to the alignment |
| 7277 | ;; character |
| 7278 | (goto-char begin) |
| 7279 | (setq eol (point-at-eol) |
| 7280 | bol (setq begin (progn (beginning-of-line) (point)))) |
| 7281 | (while (< bol end) |
| 7282 | (save-excursion |
| 7283 | (when (and (re-search-forward match eol t) |
| 7284 | (not (vhdl-in-literal))) |
| 7285 | (setq distance (- (match-beginning substr) bol)) |
| 7286 | (when (> distance max) |
| 7287 | (setq max distance)))) |
| 7288 | (forward-line) |
| 7289 | (setq bol (point) |
| 7290 | eol (point-at-eol)) |
| 7291 | (setq lines (1+ lines))) |
| 7292 | ;; Now insert enough maxs to push each assignment operator to |
| 7293 | ;; the same column. We need to use 'lines' as a counter, since |
| 7294 | ;; the location of the mark may change |
| 7295 | (goto-char (setq bol begin)) |
| 7296 | (setq eol (point-at-eol)) |
| 7297 | (while (> lines 0) |
| 7298 | (when (and (re-search-forward match eol t) |
| 7299 | (not (vhdl-in-literal))) |
| 7300 | (setq width (- (match-end substr) (match-beginning substr))) |
| 7301 | (setq distance (- (match-beginning substr) bol)) |
| 7302 | (goto-char (match-beginning substr)) |
| 7303 | (delete-char width) |
| 7304 | (insert-char ? (+ (- max distance) spacing))) |
| 7305 | (beginning-of-line) |
| 7306 | (forward-line) |
| 7307 | (setq bol (point) |
| 7308 | eol (point-at-eol)) |
| 7309 | (setq lines (1- lines)))))) |
| 7310 | |
| 7311 | (defun vhdl-align-region-groups (beg end &optional spacing |
| 7312 | no-message no-comments) |
| 7313 | "Align region, treat groups of lines separately." |
| 7314 | (interactive "r\nP") |
| 7315 | (save-excursion |
| 7316 | (let (orig pos) |
| 7317 | (goto-char beg) |
| 7318 | (beginning-of-line) |
| 7319 | (setq orig (point-marker)) |
| 7320 | (setq beg (point)) |
| 7321 | (goto-char end) |
| 7322 | (setq end (point-marker)) |
| 7323 | (untabify beg end) |
| 7324 | (unless no-message |
| 7325 | (when vhdl-progress-interval |
| 7326 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7327 | (count-lines (point-min) end) 0)))) |
| 7328 | (vhdl-fixup-whitespace-region beg end t) |
| 7329 | (goto-char beg) |
| 7330 | (if (not vhdl-align-groups) |
| 7331 | ;; align entire region |
| 7332 | (progn (vhdl-align-region-1 beg end spacing) |
| 7333 | (unless no-comments |
| 7334 | (vhdl-align-inline-comment-region-1 beg end))) |
| 7335 | ;; align groups |
| 7336 | (while (and (< beg end) |
| 7337 | (re-search-forward vhdl-align-group-separate end t)) |
| 7338 | (setq pos (point-marker)) |
| 7339 | (vhdl-align-region-1 beg pos spacing) |
| 7340 | (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) |
| 7341 | (vhdl-update-progress-info "Aligning" (vhdl-current-line)) |
| 7342 | (setq beg (1+ pos)) |
| 7343 | (goto-char beg)) |
| 7344 | ;; align last group |
| 7345 | (when (< beg end) |
| 7346 | (vhdl-align-region-1 beg end spacing) |
| 7347 | (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) |
| 7348 | (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) |
| 7349 | (when vhdl-indent-tabs-mode |
| 7350 | (tabify orig end)) |
| 7351 | (unless no-message |
| 7352 | (when vhdl-progress-interval (message "Aligning...done")) |
| 7353 | (setq vhdl-progress-info nil))))) |
| 7354 | |
| 7355 | (defun vhdl-align-region (beg end &optional spacing) |
| 7356 | "Align region, treat blocks with same indent and argument lists separately." |
| 7357 | (interactive "r\nP") |
| 7358 | (if (not vhdl-align-same-indent) |
| 7359 | ;; align entire region |
| 7360 | (vhdl-align-region-groups beg end spacing) |
| 7361 | ;; align blocks with same indent and argument lists |
| 7362 | (save-excursion |
| 7363 | (let ((cur-beg beg) |
| 7364 | indent cur-end) |
| 7365 | (when vhdl-progress-interval |
| 7366 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7367 | (count-lines (point-min) end) 0))) |
| 7368 | (goto-char end) |
| 7369 | (setq end (point-marker)) |
| 7370 | (goto-char cur-beg) |
| 7371 | (while (< (point) end) |
| 7372 | ;; is argument list opening? |
| 7373 | (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp |
| 7374 | (point) (vhdl-point 'eol))))) |
| 7375 | ;; determine region for argument list |
| 7376 | (progn (goto-char cur-beg) |
| 7377 | (forward-sexp) |
| 7378 | (setq cur-end (point)) |
| 7379 | (beginning-of-line 2)) |
| 7380 | ;; determine region with same indent |
| 7381 | (setq indent (current-indentation)) |
| 7382 | (setq cur-beg (point)) |
| 7383 | (setq cur-end (vhdl-point 'bonl)) |
| 7384 | (beginning-of-line 2) |
| 7385 | (while (and (< (point) end) |
| 7386 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7387 | (= (current-indentation) indent)) |
| 7388 | (<= (save-excursion |
| 7389 | (nth 0 (parse-partial-sexp |
| 7390 | (point) (vhdl-point 'eol)))) 0)) |
| 7391 | (unless (looking-at "^\\s-*$") |
| 7392 | (setq cur-end (vhdl-point 'bonl))) |
| 7393 | (beginning-of-line 2))) |
| 7394 | ;; align region |
| 7395 | (vhdl-align-region-groups cur-beg cur-end spacing t t)) |
| 7396 | (vhdl-align-inline-comment-region beg end spacing noninteractive) |
| 7397 | (when vhdl-progress-interval (message "Aligning...done")) |
| 7398 | (setq vhdl-progress-info nil))))) |
| 7399 | |
| 7400 | (defun vhdl-align-group (&optional spacing) |
| 7401 | "Align group of lines between empty lines." |
| 7402 | (interactive) |
| 7403 | (vhdl-do-group 'vhdl-align-region spacing)) |
| 7404 | |
| 7405 | (defun vhdl-align-list (&optional spacing) |
| 7406 | "Align the lines of a list surrounded by a balanced group of parentheses." |
| 7407 | (interactive) |
| 7408 | (vhdl-do-list 'vhdl-align-region-groups spacing)) |
| 7409 | |
| 7410 | (defun vhdl-align-same-indent (&optional spacing) |
| 7411 | "Align block of lines with same indent." |
| 7412 | (interactive) |
| 7413 | (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) |
| 7414 | |
| 7415 | (defun vhdl-align-declarations (&optional spacing) |
| 7416 | "Align the lines within the declarative part of a design unit." |
| 7417 | (interactive) |
| 7418 | (let (beg end) |
| 7419 | (vhdl-prepare-search-2 |
| 7420 | (save-excursion |
| 7421 | ;; search for declarative part |
| 7422 | (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t) |
| 7423 | (not (member (upcase (match-string 1)) '("BEGIN" "END")))) |
| 7424 | (setq beg (point)) |
| 7425 | (re-search-forward "^\\(begin\\|end\\)\\>" nil t) |
| 7426 | (setq end (point))))) |
| 7427 | (if beg |
| 7428 | (vhdl-align-region-groups beg end spacing) |
| 7429 | (error "ERROR: Not within the declarative part of a design unit")))) |
| 7430 | |
| 7431 | (defun vhdl-align-buffer () |
| 7432 | "Align buffer." |
| 7433 | (interactive) |
| 7434 | (vhdl-align-region (point-min) (point-max))) |
| 7435 | |
| 7436 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7437 | ;; Align inline comments |
| 7438 | |
| 7439 | (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) |
| 7440 | "Align inline comments in region." |
| 7441 | (save-excursion |
| 7442 | (let ((start-max comment-column) |
| 7443 | (length-max 0) |
| 7444 | comment-list start-list tmp-list start length |
| 7445 | cur-start prev-start no-code) |
| 7446 | (setq spacing (or spacing 2)) |
| 7447 | (vhdl-prepare-search-2 |
| 7448 | (goto-char beg) |
| 7449 | ;; search for comment start positions and lengths |
| 7450 | (while (< (point) end) |
| 7451 | (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) |
| 7452 | (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$") |
| 7453 | (not (save-excursion (goto-char (match-beginning 2)) |
| 7454 | (vhdl-in-literal)))) |
| 7455 | (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) |
| 7456 | (setq length (- (match-end 2) (match-beginning 2))) |
| 7457 | (setq start-max (max start start-max)) |
| 7458 | (setq length-max (max length length-max)) |
| 7459 | (setq comment-list (cons (cons start length) comment-list))) |
| 7460 | (beginning-of-line 2)) |
| 7461 | (setq comment-list |
| 7462 | (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) |
| 7463 | ;; reduce start positions |
| 7464 | (setq start-list (list (caar comment-list))) |
| 7465 | (setq comment-list (cdr comment-list)) |
| 7466 | (while comment-list |
| 7467 | (unless (or (= (caar comment-list) (car start-list)) |
| 7468 | (<= (+ (car start-list) (cdar comment-list)) |
| 7469 | end-comment-column)) |
| 7470 | (setq start-list (cons (caar comment-list) start-list))) |
| 7471 | (setq comment-list (cdr comment-list))) |
| 7472 | ;; align lines as nicely as possible |
| 7473 | (goto-char beg) |
| 7474 | (while (< (point) end) |
| 7475 | (setq cur-start nil) |
| 7476 | (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) |
| 7477 | (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$") |
| 7478 | (not (save-excursion |
| 7479 | (goto-char (match-beginning 3)) |
| 7480 | (vhdl-in-literal)))) |
| 7481 | (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") |
| 7482 | (>= (- (match-end 2) (match-beginning 2)) |
| 7483 | comment-column)))) |
| 7484 | (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) |
| 7485 | (setq length (- (match-end 3) (match-beginning 3))) |
| 7486 | (setq no-code (= (match-beginning 1) (match-end 1))) |
| 7487 | ;; insert minimum whitespace |
| 7488 | (goto-char (match-end 2)) |
| 7489 | (delete-region (match-beginning 2) (match-end 2)) |
| 7490 | (insert-char ?\ spacing) |
| 7491 | (setq tmp-list start-list) |
| 7492 | ;; insert additional whitespace to align |
| 7493 | (setq cur-start |
| 7494 | (cond |
| 7495 | ;; align comment-only line to inline comment of previous line |
| 7496 | ((and no-code prev-start |
| 7497 | (<= length (- end-comment-column prev-start))) |
| 7498 | prev-start) |
| 7499 | ;; align all comments at `start-max' if this is possible |
| 7500 | ((<= (+ start-max length-max) end-comment-column) |
| 7501 | start-max) |
| 7502 | ;; align at `comment-column' if possible |
| 7503 | ((and (<= start comment-column) |
| 7504 | (<= length (- end-comment-column comment-column))) |
| 7505 | comment-column) |
| 7506 | ;; align at left-most possible start position otherwise |
| 7507 | (t |
| 7508 | (while (and tmp-list (< (car tmp-list) start)) |
| 7509 | (setq tmp-list (cdr tmp-list))) |
| 7510 | (car tmp-list)))) |
| 7511 | (indent-to cur-start)) |
| 7512 | (setq prev-start cur-start) |
| 7513 | (beginning-of-line 2)))))) |
| 7514 | |
| 7515 | (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) |
| 7516 | "Align inline comments within a region. Groups of code lines separated by |
| 7517 | empty lines are aligned individually, if `vhdl-align-groups' is non-nil." |
| 7518 | (interactive "r\nP") |
| 7519 | (save-excursion |
| 7520 | (let (orig pos) |
| 7521 | (goto-char beg) |
| 7522 | (beginning-of-line) |
| 7523 | (setq orig (point-marker)) |
| 7524 | (setq beg (point)) |
| 7525 | (goto-char end) |
| 7526 | (setq end (point-marker)) |
| 7527 | (untabify beg end) |
| 7528 | (unless no-message (message "Aligning inline comments...")) |
| 7529 | (goto-char beg) |
| 7530 | (if (not vhdl-align-groups) |
| 7531 | ;; align entire region |
| 7532 | (vhdl-align-inline-comment-region-1 beg end spacing) |
| 7533 | ;; align groups |
| 7534 | (while (and (< beg end) |
| 7535 | (re-search-forward vhdl-align-group-separate end t)) |
| 7536 | (setq pos (point-marker)) |
| 7537 | (vhdl-align-inline-comment-region-1 beg pos spacing) |
| 7538 | (setq beg (1+ pos)) |
| 7539 | (goto-char beg)) |
| 7540 | ;; align last group |
| 7541 | (when (< beg end) |
| 7542 | (vhdl-align-inline-comment-region-1 beg end spacing))) |
| 7543 | (when vhdl-indent-tabs-mode |
| 7544 | (tabify orig end)) |
| 7545 | (unless no-message (message "Aligning inline comments...done"))))) |
| 7546 | |
| 7547 | (defun vhdl-align-inline-comment-group (&optional spacing) |
| 7548 | "Align inline comments within a group of lines between empty lines." |
| 7549 | (interactive) |
| 7550 | (save-excursion |
| 7551 | (let ((start (point)) |
| 7552 | beg end) |
| 7553 | (setq end (if (re-search-forward vhdl-align-group-separate nil t) |
| 7554 | (point-marker) (point-max))) |
| 7555 | (goto-char start) |
| 7556 | (setq beg (if (re-search-backward vhdl-align-group-separate nil t) |
| 7557 | (point) (point-min))) |
| 7558 | (untabify beg end) |
| 7559 | (message "Aligning inline comments...") |
| 7560 | (vhdl-align-inline-comment-region-1 beg end) |
| 7561 | (when vhdl-indent-tabs-mode |
| 7562 | (tabify beg end)) |
| 7563 | (message "Aligning inline comments...done")))) |
| 7564 | |
| 7565 | (defun vhdl-align-inline-comment-buffer () |
| 7566 | "Align inline comments within buffer. Groups of code lines separated by |
| 7567 | empty lines are aligned individually, if `vhdl-align-groups' is non-nil." |
| 7568 | (interactive) |
| 7569 | (vhdl-align-inline-comment-region (point-min) (point-max))) |
| 7570 | |
| 7571 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7572 | ;; Fixup whitespace |
| 7573 | |
| 7574 | (defun vhdl-fixup-whitespace-region (beg end &optional no-message) |
| 7575 | "Fixup whitespace in region. Surround operator symbols by one space, |
| 7576 | eliminate multiple spaces (except at beginning of line), eliminate spaces at |
| 7577 | end of line, do nothing in comments and strings." |
| 7578 | (interactive "r") |
| 7579 | (unless no-message (message "Fixing up whitespace...")) |
| 7580 | (save-excursion |
| 7581 | (goto-char end) |
| 7582 | (setq end (point-marker)) |
| 7583 | ;; have no space before and one space after `,' and ';' |
| 7584 | (goto-char beg) |
| 7585 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) |
| 7586 | (if (match-string 1) |
| 7587 | (goto-char (match-end 1)) |
| 7588 | (replace-match "\\3 " nil nil nil 3))) |
| 7589 | ;; have no space after `(' |
| 7590 | (goto-char beg) |
| 7591 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\((\\)\\s-+" end t) |
| 7592 | (if (match-string 1) |
| 7593 | (goto-char (match-end 1)) |
| 7594 | (replace-match "\\2"))) |
| 7595 | ;; have no space before `)' |
| 7596 | (goto-char beg) |
| 7597 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) |
| 7598 | (if (match-string 1) |
| 7599 | (goto-char (match-end 1)) |
| 7600 | (replace-match "\\2"))) |
| 7601 | ;; surround operator symbols by one space |
| 7602 | (goto-char beg) |
| 7603 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t) |
| 7604 | (if (match-string 1) |
| 7605 | (goto-char (match-end 1)) |
| 7606 | (replace-match "\\3 \\4 \\5") |
| 7607 | (goto-char (match-end 2)))) |
| 7608 | ;; eliminate multiple spaces and spaces at end of line |
| 7609 | (goto-char beg) |
| 7610 | (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) |
| 7611 | (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) |
| 7612 | (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) |
| 7613 | (progn (replace-match "" nil nil) t)) |
| 7614 | (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) |
| 7615 | (progn (replace-match ";" nil nil) t)) |
| 7616 | (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) |
| 7617 | (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) |
| 7618 | (progn (replace-match " " nil nil) t)) |
| 7619 | (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) |
| 7620 | (progn (replace-match " " nil nil) t)) |
| 7621 | ; (re-search-forward "[^ \t-]+" end t)))) |
| 7622 | (re-search-forward "[^ \t\"-]+" end t)))) |
| 7623 | (unless no-message (message "Fixing up whitespace...done"))) |
| 7624 | |
| 7625 | (defun vhdl-fixup-whitespace-buffer () |
| 7626 | "Fixup whitespace in buffer. Surround operator symbols by one space, |
| 7627 | eliminate multiple spaces (except at beginning of line), eliminate spaces at |
| 7628 | end of line, do nothing in comments." |
| 7629 | (interactive) |
| 7630 | (vhdl-fixup-whitespace-region (point-min) (point-max))) |
| 7631 | |
| 7632 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7633 | ;; Beautify |
| 7634 | |
| 7635 | (defun vhdl-beautify-region (beg end) |
| 7636 | "Beautify region by applying indentation, whitespace fixup, alignment, and |
| 7637 | case fixing to a region. Calls functions `vhdl-indent-buffer', |
| 7638 | `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and |
| 7639 | `vhdl-fix-case-buffer'." |
| 7640 | (interactive "r") |
| 7641 | (setq end (save-excursion (goto-char end) (point-marker))) |
| 7642 | (vhdl-indent-region beg end nil) |
| 7643 | (let ((vhdl-align-groups t)) |
| 7644 | (vhdl-align-region beg end)) |
| 7645 | (vhdl-fix-case-region beg end)) |
| 7646 | |
| 7647 | (defun vhdl-beautify-buffer () |
| 7648 | "Beautify buffer by applying indentation, whitespace fixup, alignment, and |
| 7649 | case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire |
| 7650 | buffer." |
| 7651 | (interactive) |
| 7652 | (vhdl-beautify-region (point-min) (point-max)) |
| 7653 | (when noninteractive (save-buffer))) |
| 7654 | |
| 7655 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7656 | ;; Code filling |
| 7657 | |
| 7658 | (defun vhdl-fill-region (beg end &optional arg) |
| 7659 | "Fill lines for a region of code." |
| 7660 | (interactive "r\np") |
| 7661 | (save-excursion |
| 7662 | (goto-char beg) |
| 7663 | (let ((margin (if arg (current-indentation) (current-column)))) |
| 7664 | (goto-char end) |
| 7665 | (setq end (point-marker)) |
| 7666 | ;; remove inline comments, newlines and whitespace |
| 7667 | (vhdl-comment-kill-region beg end) |
| 7668 | (vhdl-comment-kill-inline-region beg end) |
| 7669 | (subst-char-in-region beg (1- end) ?\n ?\ ) |
| 7670 | (vhdl-fixup-whitespace-region beg end) |
| 7671 | ;; wrap and end-comment-column |
| 7672 | (goto-char beg) |
| 7673 | (while (re-search-forward "\\s-" end t) |
| 7674 | (when(> (current-column) vhdl-end-comment-column) |
| 7675 | (backward-char) |
| 7676 | (when (re-search-backward "\\s-" beg t) |
| 7677 | (replace-match "\n") |
| 7678 | (indent-to margin))))))) |
| 7679 | |
| 7680 | (defun vhdl-fill-group () |
| 7681 | "Fill group of lines between empty lines." |
| 7682 | (interactive) |
| 7683 | (vhdl-do-group 'vhdl-fill-region)) |
| 7684 | |
| 7685 | (defun vhdl-fill-list () |
| 7686 | "Fill the lines of a list surrounded by a balanced group of parentheses." |
| 7687 | (interactive) |
| 7688 | (vhdl-do-list 'vhdl-fill-region)) |
| 7689 | |
| 7690 | (defun vhdl-fill-same-indent () |
| 7691 | "Fill the lines of block of lines with same indent." |
| 7692 | (interactive) |
| 7693 | (vhdl-do-same-indent 'vhdl-fill-region)) |
| 7694 | |
| 7695 | |
| 7696 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7697 | ;;; Code updating/fixing |
| 7698 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7699 | |
| 7700 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7701 | ;; Sensitivity list update |
| 7702 | |
| 7703 | ;; Strategy: |
| 7704 | ;; - no sensitivity list is generated for processes with wait statements |
| 7705 | ;; - otherwise, do the following: |
| 7706 | ;; 1. scan for all local signals (ports, signals declared in arch./blocks) |
| 7707 | ;; 2. scan for all signals already in the sensitivity list (in order to catch |
| 7708 | ;; manually entered global signals) |
| 7709 | ;; 3. signals from 1. and 2. form the list of visible signals |
| 7710 | ;; 4. search for if/elsif conditions containing an event (sequential code) |
| 7711 | ;; 5. scan for strings that are within syntactical regions where signals are |
| 7712 | ;; read but not within sequential code, and that correspond to visible |
| 7713 | ;; signals |
| 7714 | ;; 6. replace sensitivity list by list of signals from 5. |
| 7715 | |
| 7716 | (defun vhdl-update-sensitivity-list-process () |
| 7717 | "Update sensitivity list of current process." |
| 7718 | (interactive) |
| 7719 | (save-excursion |
| 7720 | (vhdl-prepare-search-2 |
| 7721 | (end-of-line) |
| 7722 | ;; look whether in process |
| 7723 | (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) |
| 7724 | (equal (upcase (match-string 2)) "PROCESS") |
| 7725 | (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) |
| 7726 | (error "ERROR: Not within a process") |
| 7727 | (message "Updating sensitivity list...") |
| 7728 | (vhdl-update-sensitivity-list) |
| 7729 | (message "Updating sensitivity list...done"))))) |
| 7730 | |
| 7731 | (defun vhdl-update-sensitivity-list-buffer () |
| 7732 | "Update sensitivity list of all processes in current buffer." |
| 7733 | (interactive) |
| 7734 | (save-excursion |
| 7735 | (vhdl-prepare-search-2 |
| 7736 | (goto-char (point-min)) |
| 7737 | (message "Updating sensitivity lists...") |
| 7738 | (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t) |
| 7739 | (goto-char (match-beginning 0)) |
| 7740 | (condition-case nil (vhdl-update-sensitivity-list) (error ""))) |
| 7741 | (message "Updating sensitivity lists...done")))) |
| 7742 | |
| 7743 | (defun vhdl-update-sensitivity-list () |
| 7744 | "Update sensitivity list." |
| 7745 | (let ((proc-beg (point)) |
| 7746 | (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) |
| 7747 | (proc-mid (re-search-backward "^\\s-*begin\\>" nil t)) |
| 7748 | seq-region-list) |
| 7749 | (cond |
| 7750 | ;; search for wait statement (no sensitivity list allowed) |
| 7751 | ((progn (goto-char proc-mid) |
| 7752 | (vhdl-re-search-forward "\\<wait\\>" proc-end t)) |
| 7753 | (error "ERROR: Process with wait statement, sensitivity list not generated")) |
| 7754 | ;; combinational process (update sensitivity list) |
| 7755 | (t |
| 7756 | (let |
| 7757 | ;; scan for visible signals |
| 7758 | ((visible-list (vhdl-get-visible-signals)) |
| 7759 | ;; define syntactic regions where signals are read |
| 7760 | (scan-regions-list |
| 7761 | '(;; right-hand side of signal/variable assignment |
| 7762 | ;; (special case: "<=" is relational operator in a condition) |
| 7763 | ((re-search-forward "[<:]=" proc-end t) |
| 7764 | (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) |
| 7765 | ;; if condition |
| 7766 | ((re-search-forward "^\\s-*if\\>" proc-end t) |
| 7767 | (re-search-forward "\\<then\\>" proc-end t)) |
| 7768 | ;; elsif condition |
| 7769 | ((re-search-forward "\\<elsif\\>" proc-end t) |
| 7770 | (re-search-forward "\\<then\\>" proc-end t)) |
| 7771 | ;; while loop condition |
| 7772 | ((re-search-forward "^\\s-*while\\>" proc-end t) |
| 7773 | (re-search-forward "\\<loop\\>" proc-end t)) |
| 7774 | ;; exit/next condition |
| 7775 | ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) |
| 7776 | (re-search-forward ";" proc-end t)) |
| 7777 | ;; assert condition |
| 7778 | ((re-search-forward "\\<assert\\>" proc-end t) |
| 7779 | (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) |
| 7780 | ;; case expression |
| 7781 | ((re-search-forward "^\\s-*case\\>" proc-end t) |
| 7782 | (re-search-forward "\\<is\\>" proc-end t)) |
| 7783 | ;; parameter list of procedure call |
| 7784 | ((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t) |
| 7785 | (1- (point))) |
| 7786 | (progn (backward-char) (forward-sexp) |
| 7787 | (while (looking-at "(") (forward-sexp)) (point))))) |
| 7788 | name read-list sens-list signal-list |
| 7789 | sens-beg sens-end beg end margin) |
| 7790 | ;; scan for signals in old sensitivity list |
| 7791 | (goto-char proc-beg) |
| 7792 | (re-search-forward "\\<process\\>" proc-mid t) |
| 7793 | (if (not (looking-at "[ \t\n]*(")) |
| 7794 | (setq sens-beg (point)) |
| 7795 | (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t)) |
| 7796 | (goto-char (match-end 1)) |
| 7797 | (forward-sexp) |
| 7798 | (setq sens-end (1- (point))) |
| 7799 | (goto-char sens-beg) |
| 7800 | (while (and (re-search-forward "\\(\\w+\\)" sens-end t) |
| 7801 | (setq sens-list |
| 7802 | (cons (downcase (match-string 0)) sens-list)) |
| 7803 | (re-search-forward "\\s-*,\\s-*" sens-end t)))) |
| 7804 | (setq signal-list (append visible-list sens-list)) |
| 7805 | ;; search for sequential parts |
| 7806 | (goto-char proc-mid) |
| 7807 | (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) |
| 7808 | (setq end (re-search-forward "\\<then\\>" proc-end t)) |
| 7809 | (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) |
| 7810 | (goto-char end) |
| 7811 | (backward-word 1) |
| 7812 | (vhdl-forward-sexp) |
| 7813 | (setq seq-region-list (cons (cons end (point)) seq-region-list)) |
| 7814 | (beginning-of-line))) |
| 7815 | ;; scan for signals read in process |
| 7816 | (while scan-regions-list |
| 7817 | (goto-char proc-mid) |
| 7818 | (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) |
| 7819 | (setq end (eval (nth 1 (car scan-regions-list))))) |
| 7820 | (goto-char beg) |
| 7821 | (unless (or (vhdl-in-literal) |
| 7822 | (and seq-region-list |
| 7823 | (let ((tmp-list seq-region-list)) |
| 7824 | (while (and tmp-list |
| 7825 | (< (point) (caar tmp-list))) |
| 7826 | (setq tmp-list (cdr tmp-list))) |
| 7827 | (and tmp-list (< (point) (cdar tmp-list)))))) |
| 7828 | (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>[ \t\n]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) |
| 7829 | (setq name (match-string 1)) |
| 7830 | (when (and (not (match-string 4)) ; not when formal parameter |
| 7831 | (not (and (match-string 3) ; not event attribute |
| 7832 | (not (member (downcase (match-string 3)) |
| 7833 | '("event" "last_event" "transaction"))))) |
| 7834 | (member (downcase name) signal-list)) |
| 7835 | (unless (member-ignore-case name read-list) |
| 7836 | (setq read-list (cons name read-list)))) |
| 7837 | (goto-char (match-end 1))))) |
| 7838 | (setq scan-regions-list (cdr scan-regions-list))) |
| 7839 | ;; update sensitivity list |
| 7840 | (goto-char sens-beg) |
| 7841 | (if sens-end |
| 7842 | (delete-region sens-beg sens-end) |
| 7843 | (when read-list |
| 7844 | (insert " ()") (backward-char))) |
| 7845 | (setq read-list (sort read-list 'string<)) |
| 7846 | (when read-list |
| 7847 | (setq margin (current-column)) |
| 7848 | (insert (car read-list)) |
| 7849 | (setq read-list (cdr read-list)) |
| 7850 | (while read-list |
| 7851 | (insert ",") |
| 7852 | (if (<= (+ (current-column) (length (car read-list)) 2) |
| 7853 | end-comment-column) |
| 7854 | (insert " ") |
| 7855 | (insert "\n") (indent-to margin)) |
| 7856 | (insert (car read-list)) |
| 7857 | (setq read-list (cdr read-list))))))))) |
| 7858 | |
| 7859 | (defun vhdl-get-visible-signals () |
| 7860 | "Get all signals visible in the current block." |
| 7861 | (let (beg end signal-list entity-name file-name) |
| 7862 | (vhdl-prepare-search-2 |
| 7863 | ;; get entity name |
| 7864 | (save-excursion |
| 7865 | (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) |
| 7866 | (not (equal "END" (upcase (match-string 1)))) |
| 7867 | (setq entity-name (match-string 2))) |
| 7868 | (error "ERROR: Not within an architecture"))) |
| 7869 | ;; search for signals declared in entity port clause |
| 7870 | (save-excursion |
| 7871 | (goto-char (point-min)) |
| 7872 | (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) |
| 7873 | (setq file-name |
| 7874 | (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) |
| 7875 | "." (file-name-extension (buffer-file-name))))) |
| 7876 | (vhdl-visit-file |
| 7877 | file-name t |
| 7878 | (vhdl-prepare-search-2 |
| 7879 | (goto-char (point-min)) |
| 7880 | (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) |
| 7881 | (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) |
| 7882 | (when (setq beg (re-search-forward |
| 7883 | "^\\s-*port[ \t\n]*(" |
| 7884 | (save-excursion |
| 7885 | (re-search-forward "^end\\>" nil t)) t)) |
| 7886 | (setq end (save-excursion |
| 7887 | (backward-char) (forward-sexp) (point))) |
| 7888 | (vhdl-forward-syntactic-ws) |
| 7889 | (while (< (point) end) |
| 7890 | (when (looking-at "signal[ \t\n]+") |
| 7891 | (goto-char (match-end 0))) |
| 7892 | (while (looking-at "\\(\\w+\\)[ \t\n,]+") |
| 7893 | (setq signal-list |
| 7894 | (cons (downcase (match-string 1)) signal-list)) |
| 7895 | (goto-char (match-end 0)) |
| 7896 | (vhdl-forward-syntactic-ws)) |
| 7897 | (re-search-forward ";" end 1) |
| 7898 | (vhdl-forward-syntactic-ws))))))) |
| 7899 | ;; search for signals declared in architecture declarative part |
| 7900 | (save-excursion |
| 7901 | (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) |
| 7902 | (not (equal "END" (upcase (match-string 1)))) |
| 7903 | (setq end (re-search-forward "^begin\\>" nil t)))) |
| 7904 | (error "ERROR: No architecture declarative part found") |
| 7905 | ;; scan for all declared signal and alias names |
| 7906 | (goto-char beg) |
| 7907 | (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) |
| 7908 | (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) |
| 7909 | (if (match-string 2) |
| 7910 | ;; scan signal name |
| 7911 | (while (looking-at "[ \t\n,]+\\(\\w+\\)") |
| 7912 | (setq signal-list |
| 7913 | (cons (downcase (match-string 1)) signal-list)) |
| 7914 | (goto-char (match-end 0))) |
| 7915 | ;; scan alias name, check is alias of (declared) signal |
| 7916 | (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") |
| 7917 | (member (downcase (match-string 2)) signal-list)) |
| 7918 | (setq signal-list |
| 7919 | (cons (downcase (match-string 1)) signal-list)) |
| 7920 | (goto-char (match-end 0)))) |
| 7921 | (setq beg (point)))))) |
| 7922 | ;; search for signals declared in surrounding block declarative parts |
| 7923 | (save-excursion |
| 7924 | (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t)) |
| 7925 | (match-string 2)) |
| 7926 | (goto-char (match-end 2)) |
| 7927 | (vhdl-backward-sexp) |
| 7928 | (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t)) |
| 7929 | beg) |
| 7930 | (setq end (re-search-forward "^\\s-*begin\\>" nil t))) |
| 7931 | ;; scan for all declared signal names |
| 7932 | (goto-char beg) |
| 7933 | (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) |
| 7934 | (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) |
| 7935 | (if (match-string 2) |
| 7936 | ;; scan signal name |
| 7937 | (while (looking-at "[ \t\n,]+\\(\\w+\\)") |
| 7938 | (setq signal-list |
| 7939 | (cons (downcase (match-string 1)) signal-list)) |
| 7940 | (goto-char (match-end 0))) |
| 7941 | ;; scan alias name, check is alias of (declared) signal |
| 7942 | (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") |
| 7943 | (member (downcase (match-string 2)) signal-list)) |
| 7944 | (setq signal-list |
| 7945 | (cons (downcase (match-string 1)) signal-list)) |
| 7946 | (goto-char (match-end 0)))))) |
| 7947 | (goto-char beg))) |
| 7948 | signal-list))) |
| 7949 | |
| 7950 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7951 | ;; Generic/port clause fixing |
| 7952 | |
| 7953 | (defun vhdl-fix-clause () |
| 7954 | "Fix closing parenthesis within generic/port clause." |
| 7955 | (interactive) |
| 7956 | (save-excursion |
| 7957 | (vhdl-prepare-search-2 |
| 7958 | (let ((pos (point)) |
| 7959 | beg end) |
| 7960 | (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t)) |
| 7961 | (error "ERROR: Not within a generic/port clause") |
| 7962 | ;; search for end of clause |
| 7963 | (goto-char (match-end 0)) |
| 7964 | (setq beg (1- (point))) |
| 7965 | (vhdl-forward-syntactic-ws) |
| 7966 | (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;") |
| 7967 | (goto-char (1- (match-end 0))) |
| 7968 | (setq end (point-marker)) |
| 7969 | (forward-char) |
| 7970 | (vhdl-forward-syntactic-ws)) |
| 7971 | (goto-char end) |
| 7972 | (when (> pos (point-at-eol)) |
| 7973 | (error "ERROR: Not within a generic/port clause")) |
| 7974 | ;; delete closing parenthesis on separate line (not supported style) |
| 7975 | (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) |
| 7976 | (vhdl-line-kill) |
| 7977 | (vhdl-backward-syntactic-ws) |
| 7978 | (setq end (point-marker)) |
| 7979 | (insert ";")) |
| 7980 | ;; delete superfluous parentheses |
| 7981 | (while (progn (goto-char beg) |
| 7982 | (condition-case () (forward-sexp) |
| 7983 | (error (goto-char (point-max)))) |
| 7984 | (< (point) end)) |
| 7985 | (delete-char -1)) |
| 7986 | ;; add closing parenthesis |
| 7987 | (when (> (point) end) |
| 7988 | (goto-char end) |
| 7989 | (insert ")"))))))) |
| 7990 | |
| 7991 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7992 | ;; Miscellaneous |
| 7993 | |
| 7994 | (defun vhdl-remove-trailing-spaces () |
| 7995 | "Remove trailing spaces in the whole buffer." |
| 7996 | (interactive) |
| 7997 | (save-match-data |
| 7998 | (save-excursion |
| 7999 | (goto-char (point-min)) |
| 8000 | (while (re-search-forward "[ \t]+$" (point-max) t) |
| 8001 | (unless (vhdl-in-literal) |
| 8002 | (replace-match "" nil nil)))))) |
| 8003 | |
| 8004 | |
| 8005 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8006 | ;;; Electrification |
| 8007 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8008 | |
| 8009 | (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" |
| 8010 | "Syntax of prompt inserted by template generators.") |
| 8011 | |
| 8012 | (defvar vhdl-template-invoked-by-hook nil |
| 8013 | "Indicates whether a template has been invoked by a hook or by key or menu. |
| 8014 | Used for undoing after template abortion.") |
| 8015 | |
| 8016 | ;; correct different behavior of function `unread-command-events' in XEmacs |
| 8017 | (defun vhdl-character-to-event (arg)) |
| 8018 | (defalias 'vhdl-character-to-event |
| 8019 | (if (fboundp 'character-to-event) 'character-to-event 'identity)) |
| 8020 | |
| 8021 | (defun vhdl-work-library () |
| 8022 | "Return the working library name of the current project or \"work\" if no |
| 8023 | project is defined." |
| 8024 | (vhdl-resolve-env-variable |
| 8025 | (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library))) |
| 8026 | |
| 8027 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8028 | ;; Enabling/disabling |
| 8029 | |
| 8030 | (define-minor-mode vhdl-electric-mode |
| 8031 | "Toggle VHDL electric mode. |
| 8032 | With a prefix argument ARG, enable the mode if ARG is positive, |
| 8033 | and disable it otherwise. If called from Lisp, enable it if ARG |
| 8034 | is omitted or nil." |
| 8035 | :global t) |
| 8036 | |
| 8037 | (define-minor-mode vhdl-stutter-mode |
| 8038 | "Toggle VHDL stuttering mode. |
| 8039 | With a prefix argument ARG, enable the mode if ARG is positive, |
| 8040 | and disable it otherwise. If called from Lisp, enable it if ARG |
| 8041 | is omitted or nil." |
| 8042 | :global t) |
| 8043 | |
| 8044 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8045 | ;; Stuttering |
| 8046 | |
| 8047 | (defun vhdl-electric-dash (count) |
| 8048 | "-- starts a comment, --- draws a horizontal line, |
| 8049 | ---- starts a display comment." |
| 8050 | (interactive "p") |
| 8051 | (if (and vhdl-stutter-mode (not (vhdl-in-literal))) |
| 8052 | (cond |
| 8053 | ((and abbrev-start-location (= abbrev-start-location (point))) |
| 8054 | (setq abbrev-start-location nil) |
| 8055 | (goto-char last-abbrev-location) |
| 8056 | (beginning-of-line nil) |
| 8057 | (vhdl-comment-display)) |
| 8058 | ((/= (preceding-char) ?-) ; standard dash (minus) |
| 8059 | (self-insert-command count)) |
| 8060 | (t (self-insert-command count) |
| 8061 | (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment") |
| 8062 | (let ((next-input (read-char))) |
| 8063 | (if (= next-input ?-) ; triple dash |
| 8064 | (progn |
| 8065 | (vhdl-comment-display-line) |
| 8066 | (message |
| 8067 | "Enter '-' for display comment, else continue coding") |
| 8068 | (let ((next-input (read-char))) |
| 8069 | (if (= next-input ?-) ; four dashes |
| 8070 | (vhdl-comment-display t) |
| 8071 | (setq unread-command-events ; pushback the char |
| 8072 | (list (vhdl-character-to-event next-input)))))) |
| 8073 | (setq unread-command-events ; pushback the char |
| 8074 | (list (vhdl-character-to-event next-input))) |
| 8075 | (vhdl-comment-insert))))) |
| 8076 | (self-insert-command count))) |
| 8077 | |
| 8078 | (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['" |
| 8079 | (interactive "p") |
| 8080 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8081 | (if (= (preceding-char) ?\() |
| 8082 | (progn (delete-char -1) (insert-char ?\[ 1)) |
| 8083 | (insert-char ?\( 1)) |
| 8084 | (self-insert-command count))) |
| 8085 | |
| 8086 | (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'" |
| 8087 | (interactive "p") |
| 8088 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8089 | (progn |
| 8090 | (if (= (preceding-char) ?\)) |
| 8091 | (progn (delete-char -1) (insert-char ?\] 1)) |
| 8092 | (insert-char ?\) 1)) |
| 8093 | (blink-matching-open)) |
| 8094 | (self-insert-command count))) |
| 8095 | |
| 8096 | (defun vhdl-electric-quote (count) "'' --> \"" |
| 8097 | (interactive "p") |
| 8098 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8099 | (if (= (preceding-char) last-input-event) |
| 8100 | (progn (delete-char -1) (insert-char ?\" 1)) |
| 8101 | (insert-char ?\' 1)) |
| 8102 | (self-insert-command count))) |
| 8103 | |
| 8104 | (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" |
| 8105 | (interactive "p") |
| 8106 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8107 | (cond ((= (preceding-char) last-input-event) |
| 8108 | (progn (delete-char -1) |
| 8109 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8110 | (insert ": ") |
| 8111 | (setq this-command 'vhdl-electric-colon))) |
| 8112 | ((and |
| 8113 | (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) |
| 8114 | (progn (delete-char -1) (insert "= "))) |
| 8115 | (t (insert-char ?\; 1))) |
| 8116 | (self-insert-command count))) |
| 8117 | |
| 8118 | (defun vhdl-electric-comma (count) "',,' --> ' <= '" |
| 8119 | (interactive "p") |
| 8120 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8121 | (cond ((= (preceding-char) last-input-event) |
| 8122 | (progn (delete-char -1) |
| 8123 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8124 | (insert "<= "))) |
| 8125 | (t (insert-char ?\, 1))) |
| 8126 | (self-insert-command count))) |
| 8127 | |
| 8128 | (defun vhdl-electric-period (count) "'..' --> ' => '" |
| 8129 | (interactive "p") |
| 8130 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8131 | (cond ((= (preceding-char) last-input-event) |
| 8132 | (progn (delete-char -1) |
| 8133 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8134 | (insert "=> "))) |
| 8135 | (t (insert-char ?\. 1))) |
| 8136 | (self-insert-command count))) |
| 8137 | |
| 8138 | (defun vhdl-electric-equal (count) "'==' --> ' == '" |
| 8139 | (interactive "p") |
| 8140 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8141 | (cond ((= (preceding-char) last-input-event) |
| 8142 | (progn (delete-char -1) |
| 8143 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8144 | (insert "== "))) |
| 8145 | (t (insert-char ?\= 1))) |
| 8146 | (self-insert-command count))) |
| 8147 | |
| 8148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8149 | ;; VHDL templates |
| 8150 | |
| 8151 | (defun vhdl-template-paired-parens () |
| 8152 | "Insert a pair of round parentheses, placing point between them." |
| 8153 | (interactive) |
| 8154 | (insert "()") |
| 8155 | (backward-char)) |
| 8156 | |
| 8157 | (defun vhdl-template-alias () |
| 8158 | "Insert alias declaration." |
| 8159 | (interactive) |
| 8160 | (let ((start (point))) |
| 8161 | (vhdl-insert-keyword "ALIAS ") |
| 8162 | (when (vhdl-template-field "name" nil t start (point)) |
| 8163 | (insert " : ") |
| 8164 | (unless (vhdl-template-field |
| 8165 | (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") |
| 8166 | nil t) |
| 8167 | (delete-char -3)) |
| 8168 | (vhdl-insert-keyword " IS ") |
| 8169 | (vhdl-template-field "name" ";") |
| 8170 | (vhdl-comment-insert-inline)))) |
| 8171 | |
| 8172 | (defun vhdl-template-architecture () |
| 8173 | "Insert architecture." |
| 8174 | (interactive) |
| 8175 | (let ((margin (current-indentation)) |
| 8176 | (start (point)) |
| 8177 | arch-name) |
| 8178 | (vhdl-insert-keyword "ARCHITECTURE ") |
| 8179 | (when (setq arch-name |
| 8180 | (vhdl-template-field "name" nil t start (point))) |
| 8181 | (vhdl-insert-keyword " OF ") |
| 8182 | (if (save-excursion |
| 8183 | (vhdl-prepare-search-1 |
| 8184 | (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) |
| 8185 | (insert (match-string 1)) |
| 8186 | (vhdl-template-field "entity name")) |
| 8187 | (vhdl-insert-keyword " IS\n") |
| 8188 | (vhdl-template-begin-end |
| 8189 | (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin |
| 8190 | (memq vhdl-insert-empty-lines '(unit all)))))) |
| 8191 | |
| 8192 | (defun vhdl-template-array (kind &optional secondary) |
| 8193 | "Insert array type definition." |
| 8194 | (interactive) |
| 8195 | (let ((start (point))) |
| 8196 | (vhdl-insert-keyword "ARRAY (") |
| 8197 | (when (or (vhdl-template-field "range" nil (not secondary) start (point)) |
| 8198 | secondary) |
| 8199 | (vhdl-insert-keyword ") OF ") |
| 8200 | (vhdl-template-field (if (eq kind 'type) "type" "nature")) |
| 8201 | (vhdl-insert-keyword ";")))) |
| 8202 | |
| 8203 | (defun vhdl-template-assert () |
| 8204 | "Insert an assertion statement." |
| 8205 | (interactive) |
| 8206 | (let ((start (point))) |
| 8207 | (vhdl-insert-keyword "ASSERT ") |
| 8208 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8209 | (when (vhdl-template-field "condition (negated)" nil t start (point)) |
| 8210 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8211 | (setq start (point)) |
| 8212 | (vhdl-insert-keyword " REPORT ") |
| 8213 | (unless (vhdl-template-field "string expression" nil nil nil nil t) |
| 8214 | (delete-region start (point))) |
| 8215 | (setq start (point)) |
| 8216 | (vhdl-insert-keyword " SEVERITY ") |
| 8217 | (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) |
| 8218 | (delete-region start (point))) |
| 8219 | (insert ";")))) |
| 8220 | |
| 8221 | (defun vhdl-template-attribute () |
| 8222 | "Insert an attribute declaration or specification." |
| 8223 | (interactive) |
| 8224 | (if (eq (vhdl-decision-query |
| 8225 | "attribute" "(d)eclaration or (s)pecification?" t) ?s) |
| 8226 | (vhdl-template-attribute-spec) |
| 8227 | (vhdl-template-attribute-decl))) |
| 8228 | |
| 8229 | (defun vhdl-template-attribute-decl () |
| 8230 | "Insert an attribute declaration." |
| 8231 | (interactive) |
| 8232 | (let ((start (point))) |
| 8233 | (vhdl-insert-keyword "ATTRIBUTE ") |
| 8234 | (when (vhdl-template-field "name" " : " t start (point)) |
| 8235 | (vhdl-template-field "type" ";") |
| 8236 | (vhdl-comment-insert-inline)))) |
| 8237 | |
| 8238 | (defun vhdl-template-attribute-spec () |
| 8239 | "Insert an attribute specification." |
| 8240 | (interactive) |
| 8241 | (let ((start (point))) |
| 8242 | (vhdl-insert-keyword "ATTRIBUTE ") |
| 8243 | (when (vhdl-template-field "name" nil t start (point)) |
| 8244 | (vhdl-insert-keyword " OF ") |
| 8245 | (vhdl-template-field "entity names | OTHERS | ALL" " : ") |
| 8246 | (vhdl-template-field "entity class") |
| 8247 | (vhdl-insert-keyword " IS ") |
| 8248 | (vhdl-template-field "expression" ";")))) |
| 8249 | |
| 8250 | (defun vhdl-template-block () |
| 8251 | "Insert a block." |
| 8252 | (interactive) |
| 8253 | (let ((margin (current-indentation)) |
| 8254 | (start (point)) |
| 8255 | label) |
| 8256 | (vhdl-insert-keyword ": BLOCK ") |
| 8257 | (goto-char start) |
| 8258 | (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) |
| 8259 | (forward-word 1) |
| 8260 | (forward-char 1) |
| 8261 | (insert "(") |
| 8262 | (if (vhdl-template-field "[guard expression]" nil t) |
| 8263 | (insert ")") |
| 8264 | (delete-char -2)) |
| 8265 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 8266 | (insert "\n") |
| 8267 | (vhdl-template-begin-end "BLOCK" label margin) |
| 8268 | (vhdl-comment-block)))) |
| 8269 | |
| 8270 | (defun vhdl-template-block-configuration () |
| 8271 | "Insert a block configuration statement." |
| 8272 | (interactive) |
| 8273 | (let ((margin (current-indentation)) |
| 8274 | (start (point))) |
| 8275 | (vhdl-insert-keyword "FOR ") |
| 8276 | (when (vhdl-template-field "block name" nil t start (point)) |
| 8277 | (vhdl-insert-keyword "\n\n") |
| 8278 | (indent-to margin) |
| 8279 | (vhdl-insert-keyword "END FOR;") |
| 8280 | (end-of-line 0) |
| 8281 | (indent-to (+ margin vhdl-basic-offset))))) |
| 8282 | |
| 8283 | (defun vhdl-template-break () |
| 8284 | "Insert a break statement." |
| 8285 | (interactive) |
| 8286 | (let (position) |
| 8287 | (vhdl-insert-keyword "BREAK") |
| 8288 | (setq position (point)) |
| 8289 | (insert " ") |
| 8290 | (while (or |
| 8291 | (progn (vhdl-insert-keyword "FOR ") |
| 8292 | (if (vhdl-template-field "[quantity name]" " USE " t) |
| 8293 | (progn (vhdl-template-field "quantity name" " => ") t) |
| 8294 | (delete-region (point) |
| 8295 | (progn (forward-word -1) (point))) |
| 8296 | nil)) |
| 8297 | (vhdl-template-field "[quantity name]" " => " t)) |
| 8298 | (vhdl-template-field "expression") |
| 8299 | (setq position (point)) |
| 8300 | (insert ", ")) |
| 8301 | (delete-region position (point)) |
| 8302 | (unless (vhdl-sequential-statement-p) |
| 8303 | (vhdl-insert-keyword " ON ") |
| 8304 | (if (vhdl-template-field "[sensitivity list]" nil t) |
| 8305 | (setq position (point)) |
| 8306 | (delete-region position (point)))) |
| 8307 | (vhdl-insert-keyword " WHEN ") |
| 8308 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8309 | (if (vhdl-template-field "[condition]" nil t) |
| 8310 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8311 | (delete-region position (point))) |
| 8312 | (insert ";"))) |
| 8313 | |
| 8314 | (defun vhdl-template-case (&optional kind) |
| 8315 | "Insert a case statement." |
| 8316 | (interactive) |
| 8317 | (let ((margin (current-indentation)) |
| 8318 | (start (point)) |
| 8319 | label) |
| 8320 | (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use))) |
| 8321 | (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) |
| 8322 | (vhdl-insert-keyword "CASE ") |
| 8323 | (vhdl-insert-keyword ": CASE ") |
| 8324 | (goto-char start) |
| 8325 | (setq label (vhdl-template-field "[label]" nil t)) |
| 8326 | (unless label (delete-char 2)) |
| 8327 | (forward-word 1) |
| 8328 | (forward-char 1)) |
| 8329 | (when (vhdl-template-field "expression" nil t start (point)) |
| 8330 | (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) |
| 8331 | (indent-to margin) |
| 8332 | (vhdl-insert-keyword "END CASE") |
| 8333 | (when label (insert " " label)) |
| 8334 | (insert ";") |
| 8335 | (forward-line -1) |
| 8336 | (indent-to (+ margin vhdl-basic-offset)) |
| 8337 | (vhdl-insert-keyword "WHEN ") |
| 8338 | (let ((position (point))) |
| 8339 | (insert " => ;\n") |
| 8340 | (indent-to (+ margin vhdl-basic-offset)) |
| 8341 | (vhdl-insert-keyword "WHEN OTHERS => null;") |
| 8342 | (goto-char position))))) |
| 8343 | |
| 8344 | (defun vhdl-template-case-is () |
| 8345 | "Insert a sequential case statement." |
| 8346 | (interactive) |
| 8347 | (vhdl-template-case 'is)) |
| 8348 | |
| 8349 | (defun vhdl-template-case-use () |
| 8350 | "Insert a simultaneous case statement." |
| 8351 | (interactive) |
| 8352 | (vhdl-template-case 'use)) |
| 8353 | |
| 8354 | (defun vhdl-template-component () |
| 8355 | "Insert a component declaration." |
| 8356 | (interactive) |
| 8357 | (vhdl-template-component-decl)) |
| 8358 | |
| 8359 | (defun vhdl-template-component-conf () |
| 8360 | "Insert a component configuration (uses `vhdl-template-configuration-spec' |
| 8361 | since these are almost equivalent)." |
| 8362 | (interactive) |
| 8363 | (let ((margin (current-indentation)) |
| 8364 | (result (vhdl-template-configuration-spec t))) |
| 8365 | (when result |
| 8366 | (insert "\n") |
| 8367 | (indent-to margin) |
| 8368 | (vhdl-insert-keyword "END FOR;") |
| 8369 | (when (eq result 'no-use) |
| 8370 | (end-of-line -0))))) |
| 8371 | |
| 8372 | (defun vhdl-template-component-decl () |
| 8373 | "Insert a component declaration." |
| 8374 | (interactive) |
| 8375 | (let ((margin (current-indentation)) |
| 8376 | (start (point)) |
| 8377 | name end-column) |
| 8378 | (vhdl-insert-keyword "COMPONENT ") |
| 8379 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 8380 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 8381 | (insert "\n\n") |
| 8382 | (indent-to margin) |
| 8383 | (vhdl-insert-keyword "END COMPONENT") |
| 8384 | (unless (vhdl-standard-p '87) (insert " " name)) |
| 8385 | (insert ";") |
| 8386 | (setq end-column (current-column)) |
| 8387 | (end-of-line -0) |
| 8388 | (indent-to (+ margin vhdl-basic-offset)) |
| 8389 | (vhdl-template-generic-list t t) |
| 8390 | (insert "\n") |
| 8391 | (indent-to (+ margin vhdl-basic-offset)) |
| 8392 | (vhdl-template-port-list t) |
| 8393 | (beginning-of-line 2) |
| 8394 | (forward-char end-column)))) |
| 8395 | |
| 8396 | (defun vhdl-template-component-inst () |
| 8397 | "Insert a component instantiation statement." |
| 8398 | (interactive) |
| 8399 | (let ((margin (current-indentation)) |
| 8400 | (start (point)) |
| 8401 | unit position) |
| 8402 | (when (vhdl-template-field "instance label" nil t start (point)) |
| 8403 | (insert ": ") |
| 8404 | (if (not (vhdl-use-direct-instantiation)) |
| 8405 | (vhdl-template-field "component name") |
| 8406 | ;; direct instantiation |
| 8407 | (setq unit (vhdl-template-field |
| 8408 | "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) |
| 8409 | (setq unit (upcase (or unit ""))) |
| 8410 | (cond ((equal unit "ENTITY") |
| 8411 | (vhdl-template-field "library name" "." nil nil nil nil |
| 8412 | (vhdl-work-library)) |
| 8413 | (vhdl-template-field "entity name" "(") |
| 8414 | (if (vhdl-template-field "[architecture name]" nil t) |
| 8415 | (insert ")") |
| 8416 | (delete-char -1))) |
| 8417 | ((equal unit "CONFIGURATION") |
| 8418 | (vhdl-template-field "library name" "." nil nil nil nil |
| 8419 | (vhdl-work-library)) |
| 8420 | (vhdl-template-field "configuration name")) |
| 8421 | (t (vhdl-template-field "component name")))) |
| 8422 | (insert "\n") |
| 8423 | (indent-to (+ margin vhdl-basic-offset)) |
| 8424 | (setq position (point)) |
| 8425 | (vhdl-insert-keyword "GENERIC ") |
| 8426 | (when (vhdl-template-map position t t) |
| 8427 | (insert "\n") |
| 8428 | (indent-to (+ margin vhdl-basic-offset))) |
| 8429 | (setq position (point)) |
| 8430 | (vhdl-insert-keyword "PORT ") |
| 8431 | (unless (vhdl-template-map position t t) |
| 8432 | (delete-region (line-beginning-position) (point)) |
| 8433 | (delete-char -1)) |
| 8434 | (insert ";")))) |
| 8435 | |
| 8436 | (defun vhdl-template-conditional-signal-asst () |
| 8437 | "Insert a conditional signal assignment." |
| 8438 | (interactive) |
| 8439 | (when (vhdl-template-field "target signal") |
| 8440 | (insert " <= ") |
| 8441 | ; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") "")) |
| 8442 | ; (insert " ")) |
| 8443 | (let ((margin (current-column)) |
| 8444 | (start (point)) |
| 8445 | position) |
| 8446 | (vhdl-template-field "waveform") |
| 8447 | (setq position (point)) |
| 8448 | (vhdl-insert-keyword " WHEN ") |
| 8449 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8450 | (while (and (vhdl-template-field "[condition]" nil t) |
| 8451 | (progn |
| 8452 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8453 | (setq position (point)) |
| 8454 | (vhdl-insert-keyword " ELSE") |
| 8455 | (insert "\n") |
| 8456 | (indent-to margin) |
| 8457 | (vhdl-template-field "[waveform]" nil t))) |
| 8458 | (setq position (point)) |
| 8459 | (vhdl-insert-keyword " WHEN ") |
| 8460 | (when vhdl-conditions-in-parenthesis (insert "("))) |
| 8461 | (delete-region position (point)) |
| 8462 | (insert ";") |
| 8463 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 8464 | |
| 8465 | (defun vhdl-template-configuration () |
| 8466 | "Insert a configuration specification if within an architecture, |
| 8467 | a block or component configuration if within a configuration declaration, |
| 8468 | a configuration declaration if not within a design unit." |
| 8469 | (interactive) |
| 8470 | (vhdl-prepare-search-1 |
| 8471 | (cond |
| 8472 | ((and (save-excursion ; architecture body |
| 8473 | (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) |
| 8474 | (equal "ARCHITECTURE" (upcase (match-string 1)))) |
| 8475 | (vhdl-template-configuration-spec)) |
| 8476 | ((and (save-excursion ; configuration declaration |
| 8477 | (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) |
| 8478 | (equal "CONFIGURATION" (upcase (match-string 1)))) |
| 8479 | (if (eq (vhdl-decision-query |
| 8480 | "configuration" "(b)lock or (c)omponent configuration?" t) ?c) |
| 8481 | (vhdl-template-component-conf) |
| 8482 | (vhdl-template-block-configuration))) |
| 8483 | (t (vhdl-template-configuration-decl))))) ; otherwise |
| 8484 | |
| 8485 | (defun vhdl-template-configuration-spec (&optional optional-use) |
| 8486 | "Insert a configuration specification." |
| 8487 | (interactive) |
| 8488 | (let ((margin (current-indentation)) |
| 8489 | (start (point)) |
| 8490 | aspect position) |
| 8491 | (vhdl-insert-keyword "FOR ") |
| 8492 | (when (vhdl-template-field "instance names | OTHERS | ALL" " : " |
| 8493 | t start (point)) |
| 8494 | (vhdl-template-field "component name" "\n") |
| 8495 | (indent-to (+ margin vhdl-basic-offset)) |
| 8496 | (setq start (point)) |
| 8497 | (vhdl-insert-keyword "USE ") |
| 8498 | (if (and optional-use |
| 8499 | (not (setq aspect (vhdl-template-field |
| 8500 | "[ENTITY | CONFIGURATION | OPEN]" " " t)))) |
| 8501 | (progn (delete-region start (point)) 'no-use) |
| 8502 | (unless optional-use |
| 8503 | (setq aspect (vhdl-template-field |
| 8504 | "ENTITY | CONFIGURATION | OPEN" " "))) |
| 8505 | (setq aspect (upcase (or aspect ""))) |
| 8506 | (cond ((equal aspect "ENTITY") |
| 8507 | (vhdl-template-field "library name" "." nil nil nil nil |
| 8508 | (vhdl-work-library)) |
| 8509 | (vhdl-template-field "entity name" "(") |
| 8510 | (if (vhdl-template-field "[architecture name]" nil t) |
| 8511 | (insert ")") |
| 8512 | (delete-char -1)) |
| 8513 | (insert "\n") |
| 8514 | (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 8515 | (setq position (point)) |
| 8516 | (vhdl-insert-keyword "GENERIC ") |
| 8517 | (when (vhdl-template-map position t t) |
| 8518 | (insert "\n") |
| 8519 | (indent-to (+ margin (* 2 vhdl-basic-offset)))) |
| 8520 | (setq position (point)) |
| 8521 | (vhdl-insert-keyword "PORT ") |
| 8522 | (unless (vhdl-template-map position t t) |
| 8523 | (delete-region (line-beginning-position) (point)) |
| 8524 | (delete-char -1)) |
| 8525 | (insert ";") |
| 8526 | t) |
| 8527 | ((equal aspect "CONFIGURATION") |
| 8528 | (vhdl-template-field "library name" "." nil nil nil nil |
| 8529 | (vhdl-work-library)) |
| 8530 | (vhdl-template-field "configuration name" ";")) |
| 8531 | (t (delete-char -1) (insert ";") t)))))) |
| 8532 | |
| 8533 | |
| 8534 | (defun vhdl-template-configuration-decl () |
| 8535 | "Insert a configuration declaration." |
| 8536 | (interactive) |
| 8537 | (let ((margin (current-indentation)) |
| 8538 | (start (point)) |
| 8539 | entity-exists string name position) |
| 8540 | (vhdl-insert-keyword "CONFIGURATION ") |
| 8541 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 8542 | (vhdl-insert-keyword " OF ") |
| 8543 | (save-excursion |
| 8544 | (vhdl-prepare-search-1 |
| 8545 | (setq entity-exists (vhdl-re-search-backward |
| 8546 | "\\<entity \\(\\w*\\) is\\>" nil t)) |
| 8547 | (setq string (match-string 1)))) |
| 8548 | (if (and entity-exists (not (equal string ""))) |
| 8549 | (insert string) |
| 8550 | (vhdl-template-field "entity name")) |
| 8551 | (vhdl-insert-keyword " IS\n") |
| 8552 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 8553 | (indent-to (+ margin vhdl-basic-offset)) |
| 8554 | (setq position (point)) |
| 8555 | (insert "\n") |
| 8556 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 8557 | (indent-to margin) |
| 8558 | (vhdl-insert-keyword "END ") |
| 8559 | (unless (vhdl-standard-p '87) |
| 8560 | (vhdl-insert-keyword "CONFIGURATION ")) |
| 8561 | (insert name ";") |
| 8562 | (goto-char position)))) |
| 8563 | |
| 8564 | (defun vhdl-template-constant () |
| 8565 | "Insert a constant declaration." |
| 8566 | (interactive) |
| 8567 | (let ((start (point)) |
| 8568 | (in-arglist (vhdl-in-argument-list-p))) |
| 8569 | (vhdl-insert-keyword "CONSTANT ") |
| 8570 | (when (vhdl-template-field "name" nil t start (point)) |
| 8571 | (insert " : ") |
| 8572 | (when in-arglist (vhdl-insert-keyword "IN ")) |
| 8573 | (vhdl-template-field "type") |
| 8574 | (if in-arglist |
| 8575 | (progn (insert ";") |
| 8576 | (vhdl-comment-insert-inline)) |
| 8577 | (let ((position (point))) |
| 8578 | (insert " := ") |
| 8579 | (unless (vhdl-template-field "[initialization]" nil t) |
| 8580 | (delete-region position (point))) |
| 8581 | (insert ";") |
| 8582 | (vhdl-comment-insert-inline)))))) |
| 8583 | |
| 8584 | (defun vhdl-template-default () |
| 8585 | "Insert nothing." |
| 8586 | (interactive) |
| 8587 | (insert " ") |
| 8588 | (unexpand-abbrev) |
| 8589 | (backward-word 1) |
| 8590 | (vhdl-case-word 1) |
| 8591 | (forward-char 1)) |
| 8592 | |
| 8593 | (defun vhdl-template-default-indent () |
| 8594 | "Insert nothing and indent." |
| 8595 | (interactive) |
| 8596 | (insert " ") |
| 8597 | (unexpand-abbrev) |
| 8598 | (backward-word 1) |
| 8599 | (vhdl-case-word 1) |
| 8600 | (forward-char 1) |
| 8601 | (indent-according-to-mode)) |
| 8602 | |
| 8603 | (defun vhdl-template-disconnect () |
| 8604 | "Insert a disconnect statement." |
| 8605 | (interactive) |
| 8606 | (let ((start (point))) |
| 8607 | (vhdl-insert-keyword "DISCONNECT ") |
| 8608 | (when (vhdl-template-field "signal names | OTHERS | ALL" |
| 8609 | " : " t start (point)) |
| 8610 | (vhdl-template-field "type") |
| 8611 | (vhdl-insert-keyword " AFTER ") |
| 8612 | (vhdl-template-field "time expression" ";")))) |
| 8613 | |
| 8614 | (defun vhdl-template-else () |
| 8615 | "Insert an else statement." |
| 8616 | (interactive) |
| 8617 | (let (margin) |
| 8618 | (vhdl-prepare-search-1 |
| 8619 | (vhdl-insert-keyword "ELSE") |
| 8620 | (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t)) |
| 8621 | (equal "WHEN" (upcase (match-string 1)))) |
| 8622 | (insert " ") |
| 8623 | (indent-according-to-mode) |
| 8624 | (setq margin (current-indentation)) |
| 8625 | (insert "\n") |
| 8626 | (indent-to (+ margin vhdl-basic-offset)))))) |
| 8627 | |
| 8628 | (defun vhdl-template-elsif () |
| 8629 | "Insert an elsif statement." |
| 8630 | (interactive) |
| 8631 | (let ((start (point)) |
| 8632 | margin) |
| 8633 | (vhdl-insert-keyword "ELSIF ") |
| 8634 | (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams)) |
| 8635 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8636 | (when (vhdl-template-field "condition" nil t start (point)) |
| 8637 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8638 | (indent-according-to-mode) |
| 8639 | (setq margin (current-indentation)) |
| 8640 | (vhdl-insert-keyword |
| 8641 | (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n")) |
| 8642 | (indent-to (+ margin vhdl-basic-offset)))))) |
| 8643 | |
| 8644 | (defun vhdl-template-entity () |
| 8645 | "Insert an entity." |
| 8646 | (interactive) |
| 8647 | (let ((margin (current-indentation)) |
| 8648 | (start (point)) |
| 8649 | name end-column) |
| 8650 | (vhdl-insert-keyword "ENTITY ") |
| 8651 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 8652 | (vhdl-insert-keyword " IS\n\n") |
| 8653 | (indent-to margin) |
| 8654 | (vhdl-insert-keyword "END ") |
| 8655 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 8656 | (insert name ";") |
| 8657 | (setq end-column (current-column)) |
| 8658 | (end-of-line -0) |
| 8659 | (indent-to (+ margin vhdl-basic-offset)) |
| 8660 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 8661 | (indent-to (+ margin vhdl-basic-offset)) |
| 8662 | (when (vhdl-template-generic-list t) |
| 8663 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) |
| 8664 | (insert "\n") |
| 8665 | (indent-to (+ margin vhdl-basic-offset)) |
| 8666 | (when (vhdl-template-port-list t) |
| 8667 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) |
| 8668 | (beginning-of-line 2) |
| 8669 | (forward-char end-column)))) |
| 8670 | |
| 8671 | (defun vhdl-template-exit () |
| 8672 | "Insert an exit statement." |
| 8673 | (interactive) |
| 8674 | (let ((start (point))) |
| 8675 | (vhdl-insert-keyword "EXIT ") |
| 8676 | (if (vhdl-template-field "[loop label]" nil t start (point)) |
| 8677 | (let ((position (point))) |
| 8678 | (vhdl-insert-keyword " WHEN ") |
| 8679 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8680 | (if (vhdl-template-field "[condition]" nil t) |
| 8681 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8682 | (delete-region position (point)))) |
| 8683 | (delete-char -1)) |
| 8684 | (insert ";"))) |
| 8685 | |
| 8686 | (defun vhdl-template-file () |
| 8687 | "Insert a file declaration." |
| 8688 | (interactive) |
| 8689 | (let ((start (point))) |
| 8690 | (vhdl-insert-keyword "FILE ") |
| 8691 | (when (vhdl-template-field "name" nil t start (point)) |
| 8692 | (insert " : ") |
| 8693 | (vhdl-template-field "type") |
| 8694 | (unless (vhdl-standard-p '87) |
| 8695 | (vhdl-insert-keyword " OPEN ") |
| 8696 | (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" |
| 8697 | nil t) |
| 8698 | (delete-char -6))) |
| 8699 | (vhdl-insert-keyword " IS ") |
| 8700 | (when (vhdl-standard-p '87) |
| 8701 | (vhdl-template-field "[IN | OUT]" " " t)) |
| 8702 | (vhdl-template-field "filename-string" nil nil nil nil t) |
| 8703 | (insert ";") |
| 8704 | (vhdl-comment-insert-inline)))) |
| 8705 | |
| 8706 | (defun vhdl-template-for () |
| 8707 | "Insert a block or component configuration if within a configuration |
| 8708 | declaration, a configuration specification if within an architecture |
| 8709 | declarative part (and not within a subprogram), a for-loop if within a |
| 8710 | sequential statement part (subprogram or process), and a for-generate |
| 8711 | otherwise." |
| 8712 | (interactive) |
| 8713 | (vhdl-prepare-search-1 |
| 8714 | (cond |
| 8715 | ((vhdl-sequential-statement-p) ; sequential statement |
| 8716 | (vhdl-template-for-loop)) |
| 8717 | ((and (save-excursion ; configuration declaration |
| 8718 | (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) |
| 8719 | (equal "CONFIGURATION" (upcase (match-string 1)))) |
| 8720 | (if (eq (vhdl-decision-query |
| 8721 | "for" "(b)lock or (c)omponent configuration?" t) ?c) |
| 8722 | (vhdl-template-component-conf) |
| 8723 | (vhdl-template-block-configuration))) |
| 8724 | ((and (save-excursion |
| 8725 | (re-search-backward ; architecture declarative part |
| 8726 | "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) |
| 8727 | (equal "ARCHITECTURE" (upcase (match-string 1)))) |
| 8728 | (vhdl-template-configuration-spec)) |
| 8729 | (t (vhdl-template-for-generate))))) ; concurrent statement |
| 8730 | |
| 8731 | (defun vhdl-template-for-generate () |
| 8732 | "Insert a for-generate." |
| 8733 | (interactive) |
| 8734 | (let ((margin (current-indentation)) |
| 8735 | (start (point)) |
| 8736 | label position) |
| 8737 | (vhdl-insert-keyword ": FOR ") |
| 8738 | (setq position (point-marker)) |
| 8739 | (goto-char start) |
| 8740 | (when (setq label (vhdl-template-field "label" nil t start position)) |
| 8741 | (goto-char position) |
| 8742 | (vhdl-template-field "loop variable") |
| 8743 | (vhdl-insert-keyword " IN ") |
| 8744 | (vhdl-template-field "range") |
| 8745 | (vhdl-template-generate-body margin label)))) |
| 8746 | |
| 8747 | (defun vhdl-template-for-loop () |
| 8748 | "Insert a for loop." |
| 8749 | (interactive) |
| 8750 | (let ((margin (current-indentation)) |
| 8751 | (start (point)) |
| 8752 | label index) |
| 8753 | (if (not (eq vhdl-optional-labels 'all)) |
| 8754 | (vhdl-insert-keyword "FOR ") |
| 8755 | (vhdl-insert-keyword ": FOR ") |
| 8756 | (goto-char start) |
| 8757 | (setq label (vhdl-template-field "[label]" nil t)) |
| 8758 | (unless label (delete-char 2)) |
| 8759 | (forward-word 1) |
| 8760 | (forward-char 1)) |
| 8761 | (when (setq index (vhdl-template-field "loop variable" |
| 8762 | nil t start (point))) |
| 8763 | (vhdl-insert-keyword " IN ") |
| 8764 | (vhdl-template-field "range") |
| 8765 | (vhdl-insert-keyword " LOOP\n\n") |
| 8766 | (indent-to margin) |
| 8767 | (vhdl-insert-keyword "END LOOP") |
| 8768 | (if label |
| 8769 | (insert " " label ";") |
| 8770 | (insert ";") |
| 8771 | (when vhdl-self-insert-comments (insert " -- " index))) |
| 8772 | (forward-line -1) |
| 8773 | (indent-to (+ margin vhdl-basic-offset))))) |
| 8774 | |
| 8775 | (defun vhdl-template-function (&optional kind) |
| 8776 | "Insert a function declaration or body." |
| 8777 | (interactive) |
| 8778 | (let ((margin (current-indentation)) |
| 8779 | (start (point)) |
| 8780 | name) |
| 8781 | (vhdl-insert-keyword "FUNCTION ") |
| 8782 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 8783 | (vhdl-template-argument-list t) |
| 8784 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 8785 | (end-of-line) |
| 8786 | (insert "\n") |
| 8787 | (indent-to (+ margin vhdl-basic-offset)) |
| 8788 | (vhdl-insert-keyword "RETURN ") |
| 8789 | (vhdl-template-field "type") |
| 8790 | (if (if kind (eq kind 'body) |
| 8791 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) |
| 8792 | (progn (vhdl-insert-keyword " IS\n") |
| 8793 | (vhdl-template-begin-end |
| 8794 | (unless (vhdl-standard-p '87) "FUNCTION") name margin) |
| 8795 | (vhdl-comment-block)) |
| 8796 | (insert ";"))))) |
| 8797 | |
| 8798 | (defun vhdl-template-function-decl () |
| 8799 | "Insert a function declaration." |
| 8800 | (interactive) |
| 8801 | (vhdl-template-function 'decl)) |
| 8802 | |
| 8803 | (defun vhdl-template-function-body () |
| 8804 | "Insert a function declaration." |
| 8805 | (interactive) |
| 8806 | (vhdl-template-function 'body)) |
| 8807 | |
| 8808 | (defun vhdl-template-generate () |
| 8809 | "Insert a generation scheme." |
| 8810 | (interactive) |
| 8811 | (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) |
| 8812 | (vhdl-template-if-generate) |
| 8813 | (vhdl-template-for-generate))) |
| 8814 | |
| 8815 | (defun vhdl-template-generic () |
| 8816 | "Insert generic declaration, or generic map in instantiation statements." |
| 8817 | (interactive) |
| 8818 | (let ((start (point))) |
| 8819 | (vhdl-prepare-search-1 |
| 8820 | (cond |
| 8821 | ((and (save-excursion ; entity declaration |
| 8822 | (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) |
| 8823 | (equal "ENTITY" (upcase (match-string 1)))) |
| 8824 | (vhdl-template-generic-list nil)) |
| 8825 | ((or (save-excursion |
| 8826 | (or (beginning-of-line) |
| 8827 | (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) |
| 8828 | (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) |
| 8829 | (vhdl-insert-keyword "GENERIC ") |
| 8830 | (vhdl-template-map start)) |
| 8831 | (t (vhdl-template-generic-list nil t)))))) |
| 8832 | |
| 8833 | (defun vhdl-template-group () |
| 8834 | "Insert group or group template declaration." |
| 8835 | (interactive) |
| 8836 | (let ((start (point))) |
| 8837 | (if (eq (vhdl-decision-query |
| 8838 | "group" "(d)eclaration or (t)emplate declaration?" t) ?t) |
| 8839 | (vhdl-template-group-template) |
| 8840 | (vhdl-template-group-decl)))) |
| 8841 | |
| 8842 | (defun vhdl-template-group-decl () |
| 8843 | "Insert group declaration." |
| 8844 | (interactive) |
| 8845 | (let ((start (point))) |
| 8846 | (vhdl-insert-keyword "GROUP ") |
| 8847 | (when (vhdl-template-field "name" " : " t start (point)) |
| 8848 | (vhdl-template-field "template name" " (") |
| 8849 | (vhdl-template-field "constituent list" ");") |
| 8850 | (vhdl-comment-insert-inline)))) |
| 8851 | |
| 8852 | (defun vhdl-template-group-template () |
| 8853 | "Insert group template declaration." |
| 8854 | (interactive) |
| 8855 | (let ((start (point))) |
| 8856 | (vhdl-insert-keyword "GROUP ") |
| 8857 | (when (vhdl-template-field "template name" nil t start (point)) |
| 8858 | (vhdl-insert-keyword " IS (") |
| 8859 | (vhdl-template-field "entity class list" ");") |
| 8860 | (vhdl-comment-insert-inline)))) |
| 8861 | |
| 8862 | (defun vhdl-template-if () |
| 8863 | "Insert a sequential if statement or an if-generate statement." |
| 8864 | (interactive) |
| 8865 | (if (vhdl-sequential-statement-p) |
| 8866 | (vhdl-template-if-then) |
| 8867 | (if (and (vhdl-standard-p 'ams) |
| 8868 | (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) |
| 8869 | (vhdl-template-if-use) |
| 8870 | (vhdl-template-if-generate)))) |
| 8871 | |
| 8872 | (defun vhdl-template-if-generate () |
| 8873 | "Insert an if-generate." |
| 8874 | (interactive) |
| 8875 | (let ((margin (current-indentation)) |
| 8876 | (start (point)) |
| 8877 | label position) |
| 8878 | (vhdl-insert-keyword ": IF ") |
| 8879 | (setq position (point-marker)) |
| 8880 | (goto-char start) |
| 8881 | (when (setq label (vhdl-template-field "label" nil t start position)) |
| 8882 | (goto-char position) |
| 8883 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8884 | (vhdl-template-field "condition") |
| 8885 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8886 | (vhdl-template-generate-body margin label)))) |
| 8887 | |
| 8888 | (defun vhdl-template-if-then-use (kind) |
| 8889 | "Insert a sequential if statement." |
| 8890 | (interactive) |
| 8891 | (let ((margin (current-indentation)) |
| 8892 | (start (point)) |
| 8893 | label) |
| 8894 | (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) |
| 8895 | (vhdl-insert-keyword "IF ") |
| 8896 | (vhdl-insert-keyword ": IF ") |
| 8897 | (goto-char start) |
| 8898 | (setq label (vhdl-template-field "[label]" nil t)) |
| 8899 | (unless label (delete-char 2)) |
| 8900 | (forward-word 1) |
| 8901 | (forward-char 1)) |
| 8902 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8903 | (when (vhdl-template-field "condition" nil t start (point)) |
| 8904 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8905 | (vhdl-insert-keyword |
| 8906 | (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) |
| 8907 | (indent-to margin) |
| 8908 | (vhdl-insert-keyword "END IF") |
| 8909 | (when label (insert " " label)) |
| 8910 | (insert ";") |
| 8911 | (forward-line -1) |
| 8912 | (indent-to (+ margin vhdl-basic-offset))))) |
| 8913 | |
| 8914 | (defun vhdl-template-if-then () |
| 8915 | "Insert a sequential if statement." |
| 8916 | (interactive) |
| 8917 | (vhdl-template-if-then-use 'then)) |
| 8918 | |
| 8919 | (defun vhdl-template-if-use () |
| 8920 | "Insert a simultaneous if statement." |
| 8921 | (interactive) |
| 8922 | (vhdl-template-if-then-use 'use)) |
| 8923 | |
| 8924 | (defun vhdl-template-instance () |
| 8925 | "Insert a component instantiation statement." |
| 8926 | (interactive) |
| 8927 | (vhdl-template-component-inst)) |
| 8928 | |
| 8929 | (defun vhdl-template-library () |
| 8930 | "Insert a library specification." |
| 8931 | (interactive) |
| 8932 | (let ((margin (current-indentation)) |
| 8933 | (start (point)) |
| 8934 | name end-pos) |
| 8935 | (vhdl-insert-keyword "LIBRARY ") |
| 8936 | (when (setq name (vhdl-template-field "names" nil t start (point))) |
| 8937 | (insert ";") |
| 8938 | (unless (string-match "," name) |
| 8939 | (setq end-pos (point)) |
| 8940 | (insert "\n") |
| 8941 | (indent-to margin) |
| 8942 | (vhdl-insert-keyword "USE ") |
| 8943 | (insert name) |
| 8944 | (vhdl-insert-keyword "..ALL;") |
| 8945 | (backward-char 5) |
| 8946 | (if (vhdl-template-field "package name") |
| 8947 | (forward-char 5) |
| 8948 | (delete-region end-pos (+ (point) 5))))))) |
| 8949 | |
| 8950 | (defun vhdl-template-limit () |
| 8951 | "Insert a limit." |
| 8952 | (interactive) |
| 8953 | (let ((start (point))) |
| 8954 | (vhdl-insert-keyword "LIMIT ") |
| 8955 | (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " |
| 8956 | t start (point)) |
| 8957 | (vhdl-template-field "type") |
| 8958 | (vhdl-insert-keyword " WITH ") |
| 8959 | (vhdl-template-field "real expression" ";")))) |
| 8960 | |
| 8961 | (defun vhdl-template-loop () |
| 8962 | "Insert a loop." |
| 8963 | (interactive) |
| 8964 | (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) |
| 8965 | (cond ((eq char ?w) |
| 8966 | (vhdl-template-while-loop)) |
| 8967 | ((eq char ?f) |
| 8968 | (vhdl-template-for-loop)) |
| 8969 | (t (vhdl-template-bare-loop))))) |
| 8970 | |
| 8971 | (defun vhdl-template-bare-loop () |
| 8972 | "Insert a loop." |
| 8973 | (interactive) |
| 8974 | (let ((margin (current-indentation)) |
| 8975 | (start (point)) |
| 8976 | label) |
| 8977 | (if (not (eq vhdl-optional-labels 'all)) |
| 8978 | (vhdl-insert-keyword "LOOP ") |
| 8979 | (vhdl-insert-keyword ": LOOP ") |
| 8980 | (goto-char start) |
| 8981 | (setq label (vhdl-template-field "[label]" nil t)) |
| 8982 | (unless label (delete-char 2)) |
| 8983 | (forward-word 1) |
| 8984 | (delete-char 1)) |
| 8985 | (insert "\n\n") |
| 8986 | (indent-to margin) |
| 8987 | (vhdl-insert-keyword "END LOOP") |
| 8988 | (insert (if label (concat " " label ";") ";")) |
| 8989 | (forward-line -1) |
| 8990 | (indent-to (+ margin vhdl-basic-offset)))) |
| 8991 | |
| 8992 | (defun vhdl-template-map (&optional start optional secondary) |
| 8993 | "Insert a map specification with association list." |
| 8994 | (interactive) |
| 8995 | (let ((start (or start (point))) |
| 8996 | margin end-pos) |
| 8997 | (vhdl-insert-keyword "MAP (") |
| 8998 | (if (not vhdl-association-list-with-formals) |
| 8999 | (if (vhdl-template-field |
| 9000 | (concat (and optional "[") "association list" (and optional "]")) |
| 9001 | ")" (or (not secondary) optional) |
| 9002 | (and (not secondary) start) (point)) |
| 9003 | t |
| 9004 | (if (and optional secondary) (delete-region start (point))) |
| 9005 | nil) |
| 9006 | (if vhdl-argument-list-indent |
| 9007 | (setq margin (current-column)) |
| 9008 | (setq margin (+ (current-indentation) vhdl-basic-offset)) |
| 9009 | (insert "\n") |
| 9010 | (indent-to margin)) |
| 9011 | (if (vhdl-template-field |
| 9012 | (concat (and optional "[") "formal" (and optional "]")) |
| 9013 | " => " (or (not secondary) optional) |
| 9014 | (and (not secondary) start) (point)) |
| 9015 | (progn |
| 9016 | (vhdl-template-field "actual" ",") |
| 9017 | (setq end-pos (point)) |
| 9018 | (insert "\n") |
| 9019 | (indent-to margin) |
| 9020 | (while (vhdl-template-field "[formal]" " => " t) |
| 9021 | (vhdl-template-field "actual" ",") |
| 9022 | (setq end-pos (point)) |
| 9023 | (insert "\n") |
| 9024 | (indent-to margin)) |
| 9025 | (delete-region end-pos (point)) |
| 9026 | (delete-char -1) |
| 9027 | (insert ")") |
| 9028 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 9029 | t) |
| 9030 | (when (and optional secondary) (delete-region start (point))) |
| 9031 | nil)))) |
| 9032 | |
| 9033 | (defun vhdl-template-modify (&optional noerror) |
| 9034 | "Actualize modification date." |
| 9035 | (interactive) |
| 9036 | (vhdl-prepare-search-2 |
| 9037 | (save-excursion |
| 9038 | (goto-char (point-min)) |
| 9039 | (if (re-search-forward vhdl-modify-date-prefix-string nil t) |
| 9040 | (progn (delete-region (point) (progn (end-of-line) (point))) |
| 9041 | (vhdl-template-insert-date)) |
| 9042 | (unless noerror |
| 9043 | (error "ERROR: Modification date prefix string \"%s\" not found" |
| 9044 | vhdl-modify-date-prefix-string)))))) |
| 9045 | |
| 9046 | |
| 9047 | (defun vhdl-template-modify-noerror () |
| 9048 | "Call `vhdl-template-modify' with NOERROR non-nil." |
| 9049 | (vhdl-template-modify t)) |
| 9050 | |
| 9051 | (defun vhdl-template-nature () |
| 9052 | "Insert a nature declaration." |
| 9053 | (interactive) |
| 9054 | (let ((start (point)) |
| 9055 | name mid-pos end-pos) |
| 9056 | (vhdl-insert-keyword "NATURE ") |
| 9057 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9058 | (vhdl-insert-keyword " IS ") |
| 9059 | (let ((definition |
| 9060 | (upcase |
| 9061 | (or (vhdl-template-field |
| 9062 | "across type | ARRAY | RECORD") |
| 9063 | "")))) |
| 9064 | (cond ((equal definition "") |
| 9065 | (insert ";")) |
| 9066 | ((equal definition "ARRAY") |
| 9067 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9068 | (vhdl-template-array 'nature t)) |
| 9069 | ((equal definition "RECORD") |
| 9070 | (setq mid-pos (point-marker)) |
| 9071 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9072 | (vhdl-template-record 'nature name t)) |
| 9073 | (t |
| 9074 | (vhdl-insert-keyword " ACROSS ") |
| 9075 | (vhdl-template-field "through type") |
| 9076 | (vhdl-insert-keyword " THROUGH ") |
| 9077 | (vhdl-template-field "reference name") |
| 9078 | (vhdl-insert-keyword " REFERENCE;"))) |
| 9079 | (when mid-pos |
| 9080 | (setq end-pos (point-marker)) |
| 9081 | (goto-char mid-pos) |
| 9082 | (end-of-line)) |
| 9083 | (vhdl-comment-insert-inline) |
| 9084 | (when end-pos (goto-char end-pos)))))) |
| 9085 | |
| 9086 | (defun vhdl-template-next () |
| 9087 | "Insert a next statement." |
| 9088 | (interactive) |
| 9089 | (let ((start (point))) |
| 9090 | (vhdl-insert-keyword "NEXT ") |
| 9091 | (if (vhdl-template-field "[loop label]" nil t start (point)) |
| 9092 | (let ((position (point))) |
| 9093 | (vhdl-insert-keyword " WHEN ") |
| 9094 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9095 | (if (vhdl-template-field "[condition]" nil t) |
| 9096 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9097 | (delete-region position (point)))) |
| 9098 | (delete-char -1)) |
| 9099 | (insert ";"))) |
| 9100 | |
| 9101 | (defun vhdl-template-others () |
| 9102 | "Insert an others aggregate." |
| 9103 | (interactive) |
| 9104 | (let ((start (point))) |
| 9105 | (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) |
| 9106 | (progn (unless vhdl-template-invoked-by-hook (insert "(")) |
| 9107 | (vhdl-insert-keyword "OTHERS => '") |
| 9108 | (when (vhdl-template-field "value" nil t start (point)) |
| 9109 | (insert "')"))) |
| 9110 | (vhdl-insert-keyword "OTHERS ")))) |
| 9111 | |
| 9112 | (defun vhdl-template-package (&optional kind) |
| 9113 | "Insert a package specification or body." |
| 9114 | (interactive) |
| 9115 | (let ((margin (current-indentation)) |
| 9116 | (start (point)) |
| 9117 | name body position) |
| 9118 | (vhdl-insert-keyword "PACKAGE ") |
| 9119 | (setq body (if kind (eq kind 'body) |
| 9120 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) |
| 9121 | (when body |
| 9122 | (vhdl-insert-keyword "BODY ") |
| 9123 | (when (save-excursion |
| 9124 | (vhdl-prepare-search-1 |
| 9125 | (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) |
| 9126 | (insert (setq name (match-string 1))))) |
| 9127 | (when (or name |
| 9128 | (setq name (vhdl-template-field "name" nil t start (point)))) |
| 9129 | (vhdl-insert-keyword " IS\n") |
| 9130 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9131 | (indent-to (+ margin vhdl-basic-offset)) |
| 9132 | (setq position (point)) |
| 9133 | (insert "\n") |
| 9134 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9135 | (indent-to margin) |
| 9136 | (vhdl-insert-keyword "END ") |
| 9137 | (unless (vhdl-standard-p '87) |
| 9138 | (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) |
| 9139 | (insert (or name "") ";") |
| 9140 | (goto-char position)))) |
| 9141 | |
| 9142 | (defun vhdl-template-package-decl () |
| 9143 | "Insert a package specification." |
| 9144 | (interactive) |
| 9145 | (vhdl-template-package 'decl)) |
| 9146 | |
| 9147 | (defun vhdl-template-package-body () |
| 9148 | "Insert a package body." |
| 9149 | (interactive) |
| 9150 | (vhdl-template-package 'body)) |
| 9151 | |
| 9152 | (defun vhdl-template-port () |
| 9153 | "Insert a port declaration, or port map in instantiation statements." |
| 9154 | (interactive) |
| 9155 | (let ((start (point))) |
| 9156 | (vhdl-prepare-search-1 |
| 9157 | (cond |
| 9158 | ((and (save-excursion ; entity declaration |
| 9159 | (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) |
| 9160 | (equal "ENTITY" (upcase (match-string 1)))) |
| 9161 | (vhdl-template-port-list nil)) |
| 9162 | ((or (save-excursion |
| 9163 | (or (beginning-of-line) |
| 9164 | (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) |
| 9165 | (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) |
| 9166 | (vhdl-insert-keyword "PORT ") |
| 9167 | (vhdl-template-map start)) |
| 9168 | (t (vhdl-template-port-list nil)))))) |
| 9169 | |
| 9170 | (defun vhdl-template-procedural () |
| 9171 | "Insert a procedural." |
| 9172 | (interactive) |
| 9173 | (let ((margin (current-indentation)) |
| 9174 | (start (point)) |
| 9175 | (case-fold-search t) |
| 9176 | label) |
| 9177 | (vhdl-insert-keyword "PROCEDURAL ") |
| 9178 | (when (memq vhdl-optional-labels '(process all)) |
| 9179 | (goto-char start) |
| 9180 | (insert ": ") |
| 9181 | (goto-char start) |
| 9182 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9183 | (unless label (delete-char 2)) |
| 9184 | (forward-word 1) |
| 9185 | (forward-char 1)) |
| 9186 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) |
| 9187 | (insert "\n") |
| 9188 | (vhdl-template-begin-end "PROCEDURAL" label margin) |
| 9189 | (vhdl-comment-block))) |
| 9190 | |
| 9191 | (defun vhdl-template-procedure (&optional kind) |
| 9192 | "Insert a procedure declaration or body." |
| 9193 | (interactive) |
| 9194 | (let ((margin (current-indentation)) |
| 9195 | (start (point)) |
| 9196 | name) |
| 9197 | (vhdl-insert-keyword "PROCEDURE ") |
| 9198 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9199 | (vhdl-template-argument-list) |
| 9200 | (if (if kind (eq kind 'body) |
| 9201 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) |
| 9202 | (progn (vhdl-insert-keyword " IS") |
| 9203 | (when vhdl-auto-align |
| 9204 | (vhdl-align-region-groups start (point) 1)) |
| 9205 | (end-of-line) (insert "\n") |
| 9206 | (vhdl-template-begin-end |
| 9207 | (unless (vhdl-standard-p '87) "PROCEDURE") |
| 9208 | name margin) |
| 9209 | (vhdl-comment-block)) |
| 9210 | (insert ";") |
| 9211 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 9212 | (end-of-line))))) |
| 9213 | |
| 9214 | (defun vhdl-template-procedure-decl () |
| 9215 | "Insert a procedure declaration." |
| 9216 | (interactive) |
| 9217 | (vhdl-template-procedure 'decl)) |
| 9218 | |
| 9219 | (defun vhdl-template-procedure-body () |
| 9220 | "Insert a procedure body." |
| 9221 | (interactive) |
| 9222 | (vhdl-template-procedure 'body)) |
| 9223 | |
| 9224 | (defun vhdl-template-process (&optional kind) |
| 9225 | "Insert a process." |
| 9226 | (interactive) |
| 9227 | (let ((margin (current-indentation)) |
| 9228 | (start (point)) |
| 9229 | label seq input-signals clock reset final-pos) |
| 9230 | (setq seq (if kind (eq kind 'seq) |
| 9231 | (eq (vhdl-decision-query |
| 9232 | "process" "(c)ombinational or (s)equential?" t) ?s))) |
| 9233 | (vhdl-insert-keyword "PROCESS ") |
| 9234 | (when (memq vhdl-optional-labels '(process all)) |
| 9235 | (goto-char start) |
| 9236 | (insert ": ") |
| 9237 | (goto-char start) |
| 9238 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9239 | (unless label (delete-char 2)) |
| 9240 | (forward-word 1) |
| 9241 | (forward-char 1)) |
| 9242 | (insert "(") |
| 9243 | (if (not seq) |
| 9244 | (unless (setq input-signals |
| 9245 | (vhdl-template-field "[sensitivity list]" ")" t)) |
| 9246 | (setq input-signals "") |
| 9247 | (delete-char -2)) |
| 9248 | (setq clock (or (and (not (equal "" vhdl-clock-name)) |
| 9249 | (progn (insert vhdl-clock-name) vhdl-clock-name)) |
| 9250 | (vhdl-template-field "clock name") "<clock>")) |
| 9251 | (when (eq vhdl-reset-kind 'async) |
| 9252 | (insert ", ") |
| 9253 | (setq reset (or (and (not (equal "" vhdl-reset-name)) |
| 9254 | (progn (insert vhdl-reset-name) vhdl-reset-name)) |
| 9255 | (vhdl-template-field "reset name") "<reset>"))) |
| 9256 | (insert ")")) |
| 9257 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 9258 | (insert "\n") |
| 9259 | (vhdl-template-begin-end "PROCESS" label margin) |
| 9260 | (when seq (setq reset (vhdl-template-seq-process clock reset))) |
| 9261 | (when vhdl-prompt-for-comments |
| 9262 | (setq final-pos (point-marker)) |
| 9263 | (vhdl-prepare-search-2 |
| 9264 | (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) |
| 9265 | (vhdl-re-search-backward "\\<process\\>" nil t)) |
| 9266 | (end-of-line -0) |
| 9267 | (if (bobp) |
| 9268 | (progn (insert "\n") (forward-line -1)) |
| 9269 | (insert "\n")) |
| 9270 | (indent-to margin) |
| 9271 | (insert "-- purpose: ") |
| 9272 | (if (not (vhdl-template-field "[description]" nil t)) |
| 9273 | (vhdl-line-kill-entire) |
| 9274 | (insert "\n") |
| 9275 | (indent-to margin) |
| 9276 | (insert "-- type : ") |
| 9277 | (insert (if seq "sequential" "combinational") "\n") |
| 9278 | (indent-to margin) |
| 9279 | (insert "-- inputs : ") |
| 9280 | (if (not seq) |
| 9281 | (insert input-signals) |
| 9282 | (insert clock ", ") |
| 9283 | (when reset (insert reset ", ")) |
| 9284 | (unless (vhdl-template-field "[signal names]" nil t) |
| 9285 | (delete-char -2))) |
| 9286 | (insert "\n") |
| 9287 | (indent-to margin) |
| 9288 | (insert "-- outputs: ") |
| 9289 | (vhdl-template-field "[signal names]" nil t)))) |
| 9290 | (goto-char final-pos)))) |
| 9291 | |
| 9292 | (defun vhdl-template-process-comb () |
| 9293 | "Insert a combinational process." |
| 9294 | (interactive) |
| 9295 | (vhdl-template-process 'comb)) |
| 9296 | |
| 9297 | (defun vhdl-template-process-seq () |
| 9298 | "Insert a sequential process." |
| 9299 | (interactive) |
| 9300 | (vhdl-template-process 'seq)) |
| 9301 | |
| 9302 | (defun vhdl-template-quantity () |
| 9303 | "Insert a quantity declaration." |
| 9304 | (interactive) |
| 9305 | (if (vhdl-in-argument-list-p) |
| 9306 | (let ((start (point))) |
| 9307 | (vhdl-insert-keyword "QUANTITY ") |
| 9308 | (when (vhdl-template-field "names" nil t start (point)) |
| 9309 | (insert " : ") |
| 9310 | (vhdl-template-field "[IN | OUT]" " " t) |
| 9311 | (vhdl-template-field "type") |
| 9312 | (insert ";") |
| 9313 | (vhdl-comment-insert-inline))) |
| 9314 | (let ((char (vhdl-decision-query |
| 9315 | "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) |
| 9316 | (cond ((eq char ?f) (vhdl-template-quantity-free)) |
| 9317 | ((eq char ?b) (vhdl-template-quantity-branch)) |
| 9318 | ((eq char ?s) (vhdl-template-quantity-source)) |
| 9319 | (t (vhdl-template-undo (point) (point))))))) |
| 9320 | |
| 9321 | (defun vhdl-template-quantity-free () |
| 9322 | "Insert a free quantity declaration." |
| 9323 | (interactive) |
| 9324 | (vhdl-insert-keyword "QUANTITY ") |
| 9325 | (vhdl-template-field "names") |
| 9326 | (insert " : ") |
| 9327 | (vhdl-template-field "type") |
| 9328 | (let ((position (point))) |
| 9329 | (insert " := ") |
| 9330 | (unless (vhdl-template-field "[initialization]" nil t) |
| 9331 | (delete-region position (point))) |
| 9332 | (insert ";") |
| 9333 | (vhdl-comment-insert-inline))) |
| 9334 | |
| 9335 | (defun vhdl-template-quantity-branch () |
| 9336 | "Insert a branch quantity declaration." |
| 9337 | (interactive) |
| 9338 | (let (position) |
| 9339 | (vhdl-insert-keyword "QUANTITY ") |
| 9340 | (when (vhdl-template-field "[across names]" " " t) |
| 9341 | (vhdl-insert-keyword "ACROSS ")) |
| 9342 | (when (vhdl-template-field "[through names]" " " t) |
| 9343 | (vhdl-insert-keyword "THROUGH ")) |
| 9344 | (vhdl-template-field "plus terminal name") |
| 9345 | (setq position (point)) |
| 9346 | (vhdl-insert-keyword " TO ") |
| 9347 | (unless (vhdl-template-field "[minus terminal name]" nil t) |
| 9348 | (delete-region position (point))) |
| 9349 | (insert ";") |
| 9350 | (vhdl-comment-insert-inline))) |
| 9351 | |
| 9352 | (defun vhdl-template-quantity-source () |
| 9353 | "Insert a source quantity declaration." |
| 9354 | (interactive) |
| 9355 | (vhdl-insert-keyword "QUANTITY ") |
| 9356 | (vhdl-template-field "names") |
| 9357 | (insert " : ") |
| 9358 | (vhdl-template-field "type" " ") |
| 9359 | (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) |
| 9360 | (progn (vhdl-insert-keyword "NOISE ") |
| 9361 | (vhdl-template-field "power expression")) |
| 9362 | (vhdl-insert-keyword "SPECTRUM ") |
| 9363 | (vhdl-template-field "magnitude expression" ", ") |
| 9364 | (vhdl-template-field "phase expression")) |
| 9365 | (insert ";") |
| 9366 | (vhdl-comment-insert-inline)) |
| 9367 | |
| 9368 | (defun vhdl-template-record (kind &optional name secondary) |
| 9369 | "Insert a record type declaration." |
| 9370 | (interactive) |
| 9371 | (let ((margin (current-column)) |
| 9372 | (start (point)) |
| 9373 | (first t)) |
| 9374 | (vhdl-insert-keyword "RECORD\n") |
| 9375 | (indent-to (+ margin vhdl-basic-offset)) |
| 9376 | (when (or (vhdl-template-field "element names" |
| 9377 | nil (not secondary) start (point)) |
| 9378 | secondary) |
| 9379 | (while (or first (vhdl-template-field "[element names]" nil t)) |
| 9380 | (insert " : ") |
| 9381 | (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") |
| 9382 | (vhdl-comment-insert-inline) |
| 9383 | (insert "\n") |
| 9384 | (indent-to (+ margin vhdl-basic-offset)) |
| 9385 | (setq first nil)) |
| 9386 | (delete-region (line-beginning-position) (point)) |
| 9387 | (indent-to margin) |
| 9388 | (vhdl-insert-keyword "END RECORD") |
| 9389 | (unless (vhdl-standard-p '87) (and name (insert " " name))) |
| 9390 | (insert ";") |
| 9391 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 9392 | |
| 9393 | (defun vhdl-template-report () |
| 9394 | "Insert a report statement." |
| 9395 | (interactive) |
| 9396 | (let ((start (point))) |
| 9397 | (vhdl-insert-keyword "REPORT ") |
| 9398 | (if (equal "\"\"" (vhdl-template-field |
| 9399 | "string expression" nil t start (point) t)) |
| 9400 | (delete-char -2) |
| 9401 | (setq start (point)) |
| 9402 | (vhdl-insert-keyword " SEVERITY ") |
| 9403 | (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) |
| 9404 | (delete-region start (point))) |
| 9405 | (insert ";")))) |
| 9406 | |
| 9407 | (defun vhdl-template-return () |
| 9408 | "Insert a return statement." |
| 9409 | (interactive) |
| 9410 | (let ((start (point))) |
| 9411 | (vhdl-insert-keyword "RETURN ") |
| 9412 | (unless (vhdl-template-field "[expression]" nil t start (point)) |
| 9413 | (delete-char -1)) |
| 9414 | (insert ";"))) |
| 9415 | |
| 9416 | (defun vhdl-template-selected-signal-asst () |
| 9417 | "Insert a selected signal assignment." |
| 9418 | (interactive) |
| 9419 | (let ((margin (current-indentation)) |
| 9420 | (start (point)) |
| 9421 | (choices t)) |
| 9422 | (let ((position (point))) |
| 9423 | (vhdl-insert-keyword " SELECT ") |
| 9424 | (goto-char position)) |
| 9425 | (vhdl-insert-keyword "WITH ") |
| 9426 | (when (vhdl-template-field "selector expression" |
| 9427 | nil t start (+ (point) 7)) |
| 9428 | (forward-word 1) |
| 9429 | (delete-char 1) |
| 9430 | (insert "\n") |
| 9431 | (indent-to (+ margin vhdl-basic-offset)) |
| 9432 | (vhdl-template-field "target signal" " <= ") |
| 9433 | ; (vhdl-template-field "[GUARDED] [TRANSPORT]") |
| 9434 | (insert "\n") |
| 9435 | (indent-to (+ margin vhdl-basic-offset)) |
| 9436 | (vhdl-template-field "waveform") |
| 9437 | (vhdl-insert-keyword " WHEN ") |
| 9438 | (vhdl-template-field "choices" ",") |
| 9439 | (insert "\n") |
| 9440 | (indent-to (+ margin vhdl-basic-offset)) |
| 9441 | (while (and choices (vhdl-template-field "[waveform]" nil t)) |
| 9442 | (vhdl-insert-keyword " WHEN ") |
| 9443 | (if (setq choices (vhdl-template-field "[choices]" "," t)) |
| 9444 | (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 9445 | (vhdl-insert-keyword "OTHERS"))) |
| 9446 | (when choices |
| 9447 | (fixup-whitespace) |
| 9448 | (delete-char -2)) |
| 9449 | (insert ";") |
| 9450 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 9451 | |
| 9452 | (defun vhdl-template-signal () |
| 9453 | "Insert a signal declaration." |
| 9454 | (interactive) |
| 9455 | (let ((start (point)) |
| 9456 | (in-arglist (vhdl-in-argument-list-p))) |
| 9457 | (vhdl-insert-keyword "SIGNAL ") |
| 9458 | (when (vhdl-template-field "names" nil t start (point)) |
| 9459 | (insert " : ") |
| 9460 | (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) |
| 9461 | (vhdl-template-field "type") |
| 9462 | (if in-arglist |
| 9463 | (progn (insert ";") |
| 9464 | (vhdl-comment-insert-inline)) |
| 9465 | (let ((position (point))) |
| 9466 | (insert " := ") |
| 9467 | (unless (vhdl-template-field "[initialization]" nil t) |
| 9468 | (delete-region position (point))) |
| 9469 | (insert ";") |
| 9470 | (vhdl-comment-insert-inline)))))) |
| 9471 | |
| 9472 | (defun vhdl-template-subnature () |
| 9473 | "Insert a subnature declaration." |
| 9474 | (interactive) |
| 9475 | (let ((start (point)) |
| 9476 | position) |
| 9477 | (vhdl-insert-keyword "SUBNATURE ") |
| 9478 | (when (vhdl-template-field "name" nil t start (point)) |
| 9479 | (vhdl-insert-keyword " IS ") |
| 9480 | (vhdl-template-field "nature" " (") |
| 9481 | (if (vhdl-template-field "[index range]" nil t) |
| 9482 | (insert ")") |
| 9483 | (delete-char -2)) |
| 9484 | (setq position (point)) |
| 9485 | (vhdl-insert-keyword " TOLERANCE ") |
| 9486 | (if (equal "\"\"" (vhdl-template-field "[string expression]" |
| 9487 | nil t nil nil t)) |
| 9488 | (delete-region position (point)) |
| 9489 | (vhdl-insert-keyword " ACROSS ") |
| 9490 | (vhdl-template-field "string expression" nil nil nil nil t) |
| 9491 | (vhdl-insert-keyword " THROUGH")) |
| 9492 | (insert ";") |
| 9493 | (vhdl-comment-insert-inline)))) |
| 9494 | |
| 9495 | (defun vhdl-template-subprogram-body () |
| 9496 | "Insert a subprogram body." |
| 9497 | (interactive) |
| 9498 | (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) |
| 9499 | (vhdl-template-function-body) |
| 9500 | (vhdl-template-procedure-body))) |
| 9501 | |
| 9502 | (defun vhdl-template-subprogram-decl () |
| 9503 | "Insert a subprogram declaration." |
| 9504 | (interactive) |
| 9505 | (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) |
| 9506 | (vhdl-template-function-decl) |
| 9507 | (vhdl-template-procedure-decl))) |
| 9508 | |
| 9509 | (defun vhdl-template-subtype () |
| 9510 | "Insert a subtype declaration." |
| 9511 | (interactive) |
| 9512 | (let ((start (point))) |
| 9513 | (vhdl-insert-keyword "SUBTYPE ") |
| 9514 | (when (vhdl-template-field "name" nil t start (point)) |
| 9515 | (vhdl-insert-keyword " IS ") |
| 9516 | (vhdl-template-field "type" " ") |
| 9517 | (unless |
| 9518 | (vhdl-template-field "[RANGE value range | ( index range )]" nil t) |
| 9519 | (delete-char -1)) |
| 9520 | (insert ";") |
| 9521 | (vhdl-comment-insert-inline)))) |
| 9522 | |
| 9523 | (defun vhdl-template-terminal () |
| 9524 | "Insert a terminal declaration." |
| 9525 | (interactive) |
| 9526 | (let ((start (point))) |
| 9527 | (vhdl-insert-keyword "TERMINAL ") |
| 9528 | (when (vhdl-template-field "names" nil t start (point)) |
| 9529 | (insert " : ") |
| 9530 | (vhdl-template-field "nature") |
| 9531 | (insert ";") |
| 9532 | (vhdl-comment-insert-inline)))) |
| 9533 | |
| 9534 | (defun vhdl-template-type () |
| 9535 | "Insert a type declaration." |
| 9536 | (interactive) |
| 9537 | (let ((start (point)) |
| 9538 | name mid-pos end-pos) |
| 9539 | (vhdl-insert-keyword "TYPE ") |
| 9540 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9541 | (vhdl-insert-keyword " IS ") |
| 9542 | (let ((definition |
| 9543 | (upcase |
| 9544 | (or (vhdl-template-field |
| 9545 | "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t) |
| 9546 | "")))) |
| 9547 | (cond ((equal definition "") |
| 9548 | (delete-char -4) |
| 9549 | (insert ";")) |
| 9550 | ((equal definition "ARRAY") |
| 9551 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9552 | (vhdl-template-array 'type t)) |
| 9553 | ((equal definition "RECORD") |
| 9554 | (setq mid-pos (point-marker)) |
| 9555 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9556 | (vhdl-template-record 'type name t)) |
| 9557 | ((equal definition "ACCESS") |
| 9558 | (insert " ") |
| 9559 | (vhdl-template-field "type" ";")) |
| 9560 | ((equal definition "FILE") |
| 9561 | (vhdl-insert-keyword " OF ") |
| 9562 | (vhdl-template-field "type" ";")) |
| 9563 | (t (insert ";"))) |
| 9564 | (when mid-pos |
| 9565 | (setq end-pos (point-marker)) |
| 9566 | (goto-char mid-pos) |
| 9567 | (end-of-line)) |
| 9568 | (vhdl-comment-insert-inline) |
| 9569 | (when end-pos (goto-char end-pos)))))) |
| 9570 | |
| 9571 | (defun vhdl-template-use () |
| 9572 | "Insert a use clause." |
| 9573 | (interactive) |
| 9574 | (let ((start (point))) |
| 9575 | (vhdl-prepare-search-1 |
| 9576 | (vhdl-insert-keyword "USE ") |
| 9577 | (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) |
| 9578 | (vhdl-insert-keyword "..ALL;") |
| 9579 | (backward-char 6) |
| 9580 | (when (vhdl-template-field "library name" nil t start (+ (point) 6)) |
| 9581 | (forward-char 1) |
| 9582 | (vhdl-template-field "package name") |
| 9583 | (forward-char 5)))))) |
| 9584 | |
| 9585 | (defun vhdl-template-variable () |
| 9586 | "Insert a variable declaration." |
| 9587 | (interactive) |
| 9588 | (let ((start (point)) |
| 9589 | (in-arglist (vhdl-in-argument-list-p))) |
| 9590 | (vhdl-prepare-search-2 |
| 9591 | (if (or (save-excursion |
| 9592 | (and (vhdl-re-search-backward |
| 9593 | "\\<function\\|procedure\\|process\\|procedural\\|end\\>" |
| 9594 | nil t) |
| 9595 | (not (progn (backward-word 1) (looking-at "\\<end\\>"))))) |
| 9596 | (save-excursion (backward-word 1) (looking-at "\\<shared\\>"))) |
| 9597 | (vhdl-insert-keyword "VARIABLE ") |
| 9598 | (vhdl-insert-keyword "SHARED VARIABLE "))) |
| 9599 | (when (vhdl-template-field "names" nil t start (point)) |
| 9600 | (insert " : ") |
| 9601 | (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) |
| 9602 | (vhdl-template-field "type") |
| 9603 | (if in-arglist |
| 9604 | (progn (insert ";") |
| 9605 | (vhdl-comment-insert-inline)) |
| 9606 | (let ((position (point))) |
| 9607 | (insert " := ") |
| 9608 | (unless (vhdl-template-field "[initialization]" nil t) |
| 9609 | (delete-region position (point))) |
| 9610 | (insert ";") |
| 9611 | (vhdl-comment-insert-inline)))))) |
| 9612 | |
| 9613 | (defun vhdl-template-wait () |
| 9614 | "Insert a wait statement." |
| 9615 | (interactive) |
| 9616 | (vhdl-insert-keyword "WAIT ") |
| 9617 | (unless (vhdl-template-field |
| 9618 | "[ON sensitivity list] [UNTIL condition] [FOR time expression]" |
| 9619 | nil t) |
| 9620 | (delete-char -1)) |
| 9621 | (insert ";")) |
| 9622 | |
| 9623 | (defun vhdl-template-when () |
| 9624 | "Indent correctly if within a case statement." |
| 9625 | (interactive) |
| 9626 | (let ((position (point)) |
| 9627 | margin) |
| 9628 | (vhdl-prepare-search-2 |
| 9629 | (if (and (= (current-column) (current-indentation)) |
| 9630 | (vhdl-re-search-forward "\\<end\\>" nil t) |
| 9631 | (looking-at "\\s-*\\<case\\>")) |
| 9632 | (progn |
| 9633 | (setq margin (current-indentation)) |
| 9634 | (goto-char position) |
| 9635 | (delete-horizontal-space) |
| 9636 | (indent-to (+ margin vhdl-basic-offset))) |
| 9637 | (goto-char position))) |
| 9638 | (vhdl-insert-keyword "WHEN "))) |
| 9639 | |
| 9640 | (defun vhdl-template-while-loop () |
| 9641 | "Insert a while loop." |
| 9642 | (interactive) |
| 9643 | (let* ((margin (current-indentation)) |
| 9644 | (start (point)) |
| 9645 | label) |
| 9646 | (if (not (eq vhdl-optional-labels 'all)) |
| 9647 | (vhdl-insert-keyword "WHILE ") |
| 9648 | (vhdl-insert-keyword ": WHILE ") |
| 9649 | (goto-char start) |
| 9650 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9651 | (unless label (delete-char 2)) |
| 9652 | (forward-word 1) |
| 9653 | (forward-char 1)) |
| 9654 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9655 | (when (vhdl-template-field "condition" nil t start (point)) |
| 9656 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9657 | (vhdl-insert-keyword " LOOP\n\n") |
| 9658 | (indent-to margin) |
| 9659 | (vhdl-insert-keyword "END LOOP") |
| 9660 | (insert (if label (concat " " label ";") ";")) |
| 9661 | (forward-line -1) |
| 9662 | (indent-to (+ margin vhdl-basic-offset))))) |
| 9663 | |
| 9664 | (defun vhdl-template-with () |
| 9665 | "Insert a with statement (i.e. selected signal assignment)." |
| 9666 | (interactive) |
| 9667 | (vhdl-prepare-search-1 |
| 9668 | (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) |
| 9669 | (equal ";" (match-string 1))) |
| 9670 | (vhdl-template-selected-signal-asst) |
| 9671 | (vhdl-insert-keyword "WITH ")))) |
| 9672 | |
| 9673 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 9674 | ;; Special templates |
| 9675 | |
| 9676 | (defun vhdl-template-clocked-wait () |
| 9677 | "Insert a wait statement for rising/falling clock edge." |
| 9678 | (interactive) |
| 9679 | (let ((start (point)) |
| 9680 | clock) |
| 9681 | (vhdl-insert-keyword "WAIT UNTIL ") |
| 9682 | (when (setq clock |
| 9683 | (or (and (not (equal "" vhdl-clock-name)) |
| 9684 | (progn (insert vhdl-clock-name) vhdl-clock-name)) |
| 9685 | (vhdl-template-field "clock name" nil t start (point)))) |
| 9686 | (insert "'event") |
| 9687 | (vhdl-insert-keyword " AND ") |
| 9688 | (insert clock) |
| 9689 | (insert |
| 9690 | " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") |
| 9691 | (vhdl-comment-insert-inline |
| 9692 | (concat (if vhdl-clock-rising-edge "rising" "falling") |
| 9693 | " clock edge"))))) |
| 9694 | |
| 9695 | (defun vhdl-template-seq-process (clock reset) |
| 9696 | "Insert a template for the body of a sequential process." |
| 9697 | (let ((margin (current-indentation)) |
| 9698 | position) |
| 9699 | (vhdl-insert-keyword "IF ") |
| 9700 | (when (eq vhdl-reset-kind 'async) |
| 9701 | (insert reset " = " |
| 9702 | (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) |
| 9703 | (vhdl-insert-keyword " THEN") |
| 9704 | (vhdl-comment-insert-inline |
| 9705 | (concat "asynchronous reset (active " |
| 9706 | (if vhdl-reset-active-high "high" "low") ")")) |
| 9707 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 9708 | (setq position (point)) |
| 9709 | (insert "\n") (indent-to margin) |
| 9710 | (vhdl-insert-keyword "ELSIF ")) |
| 9711 | (if (eq vhdl-clock-edge-condition 'function) |
| 9712 | (insert (if vhdl-clock-rising-edge "rising" "falling") |
| 9713 | "_edge(" clock ")") |
| 9714 | (insert clock "'event") |
| 9715 | (vhdl-insert-keyword " AND ") |
| 9716 | (insert clock " = " |
| 9717 | (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) |
| 9718 | (vhdl-insert-keyword " THEN") |
| 9719 | (vhdl-comment-insert-inline |
| 9720 | (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) |
| 9721 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 9722 | (when (eq vhdl-reset-kind 'sync) |
| 9723 | (vhdl-insert-keyword "IF ") |
| 9724 | (setq reset (or (and (not (equal "" vhdl-reset-name)) |
| 9725 | (progn (insert vhdl-reset-name) vhdl-reset-name)) |
| 9726 | (vhdl-template-field "reset name") "<reset>")) |
| 9727 | (insert " = " |
| 9728 | (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) |
| 9729 | (vhdl-insert-keyword " THEN") |
| 9730 | (vhdl-comment-insert-inline |
| 9731 | (concat "synchronous reset (active " |
| 9732 | (if vhdl-reset-active-high "high" "low") ")")) |
| 9733 | (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 9734 | (setq position (point)) |
| 9735 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 9736 | (vhdl-insert-keyword "ELSE") |
| 9737 | (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 9738 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 9739 | (vhdl-insert-keyword "END IF;")) |
| 9740 | (when (eq vhdl-reset-kind 'none) |
| 9741 | (setq position (point))) |
| 9742 | (insert "\n") (indent-to margin) |
| 9743 | (vhdl-insert-keyword "END IF;") |
| 9744 | (goto-char position) |
| 9745 | reset)) |
| 9746 | |
| 9747 | (defun vhdl-template-standard-package (library package) |
| 9748 | "Insert specification of a standard package. Include a library |
| 9749 | specification, if not already there." |
| 9750 | (let ((margin (current-indentation))) |
| 9751 | (unless (equal library "std") |
| 9752 | (unless (or (save-excursion |
| 9753 | (vhdl-prepare-search-1 |
| 9754 | (and (not (bobp)) |
| 9755 | (re-search-backward |
| 9756 | (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" |
| 9757 | library "\\|end\\)\\>") nil t) |
| 9758 | (match-string 2)))) |
| 9759 | (equal (downcase library) "work")) |
| 9760 | (vhdl-insert-keyword "LIBRARY ") |
| 9761 | (insert library ";") |
| 9762 | (when package |
| 9763 | (insert "\n") |
| 9764 | (indent-to margin))) |
| 9765 | (when package |
| 9766 | (vhdl-insert-keyword "USE ") |
| 9767 | (insert library "." package) |
| 9768 | (vhdl-insert-keyword ".ALL;"))))) |
| 9769 | |
| 9770 | (defun vhdl-template-package-math-complex () |
| 9771 | "Insert specification of `math_complex' package." |
| 9772 | (interactive) |
| 9773 | (vhdl-template-standard-package "ieee" "math_complex")) |
| 9774 | |
| 9775 | (defun vhdl-template-package-math-real () |
| 9776 | "Insert specification of `math_real' package." |
| 9777 | (interactive) |
| 9778 | (vhdl-template-standard-package "ieee" "math_real")) |
| 9779 | |
| 9780 | (defun vhdl-template-package-numeric-bit () |
| 9781 | "Insert specification of `numeric_bit' package." |
| 9782 | (interactive) |
| 9783 | (vhdl-template-standard-package "ieee" "numeric_bit")) |
| 9784 | |
| 9785 | (defun vhdl-template-package-numeric-std () |
| 9786 | "Insert specification of `numeric_std' package." |
| 9787 | (interactive) |
| 9788 | (vhdl-template-standard-package "ieee" "numeric_std")) |
| 9789 | |
| 9790 | (defun vhdl-template-package-std-logic-1164 () |
| 9791 | "Insert specification of `std_logic_1164' package." |
| 9792 | (interactive) |
| 9793 | (vhdl-template-standard-package "ieee" "std_logic_1164")) |
| 9794 | |
| 9795 | (defun vhdl-template-package-std-logic-arith () |
| 9796 | "Insert specification of `std_logic_arith' package." |
| 9797 | (interactive) |
| 9798 | (vhdl-template-standard-package "ieee" "std_logic_arith")) |
| 9799 | |
| 9800 | (defun vhdl-template-package-std-logic-misc () |
| 9801 | "Insert specification of `std_logic_misc' package." |
| 9802 | (interactive) |
| 9803 | (vhdl-template-standard-package "ieee" "std_logic_misc")) |
| 9804 | |
| 9805 | (defun vhdl-template-package-std-logic-signed () |
| 9806 | "Insert specification of `std_logic_signed' package." |
| 9807 | (interactive) |
| 9808 | (vhdl-template-standard-package "ieee" "std_logic_signed")) |
| 9809 | |
| 9810 | (defun vhdl-template-package-std-logic-textio () |
| 9811 | "Insert specification of `std_logic_textio' package." |
| 9812 | (interactive) |
| 9813 | (vhdl-template-standard-package "ieee" "std_logic_textio")) |
| 9814 | |
| 9815 | (defun vhdl-template-package-std-logic-unsigned () |
| 9816 | "Insert specification of `std_logic_unsigned' package." |
| 9817 | (interactive) |
| 9818 | (vhdl-template-standard-package "ieee" "std_logic_unsigned")) |
| 9819 | |
| 9820 | (defun vhdl-template-package-textio () |
| 9821 | "Insert specification of `textio' package." |
| 9822 | (interactive) |
| 9823 | (vhdl-template-standard-package "std" "textio")) |
| 9824 | |
| 9825 | (defun vhdl-template-directive (directive) |
| 9826 | "Insert directive." |
| 9827 | (unless (= (current-indentation) (current-column)) |
| 9828 | (delete-horizontal-space) |
| 9829 | (insert " ")) |
| 9830 | (insert "-- pragma " directive)) |
| 9831 | |
| 9832 | (defun vhdl-template-directive-translate-on () |
| 9833 | "Insert directive 'translate_on'." |
| 9834 | (interactive) |
| 9835 | (vhdl-template-directive "translate_on")) |
| 9836 | |
| 9837 | (defun vhdl-template-directive-translate-off () |
| 9838 | "Insert directive 'translate_off'." |
| 9839 | (interactive) |
| 9840 | (vhdl-template-directive "translate_off")) |
| 9841 | |
| 9842 | (defun vhdl-template-directive-synthesis-on () |
| 9843 | "Insert directive 'synthesis_on'." |
| 9844 | (interactive) |
| 9845 | (vhdl-template-directive "synthesis_on")) |
| 9846 | |
| 9847 | (defun vhdl-template-directive-synthesis-off () |
| 9848 | "Insert directive 'synthesis_off'." |
| 9849 | (interactive) |
| 9850 | (vhdl-template-directive "synthesis_off")) |
| 9851 | |
| 9852 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 9853 | ;; Header and footer templates |
| 9854 | |
| 9855 | (defun vhdl-template-header (&optional file-title) |
| 9856 | "Insert a VHDL file header." |
| 9857 | (interactive) |
| 9858 | (unless (equal vhdl-file-header "") |
| 9859 | (let (pos) |
| 9860 | (save-excursion |
| 9861 | (goto-char (point-min)) |
| 9862 | (vhdl-insert-string-or-file vhdl-file-header) |
| 9863 | (setq pos (point-marker))) |
| 9864 | (vhdl-template-replace-header-keywords |
| 9865 | (point-min-marker) pos file-title)))) |
| 9866 | |
| 9867 | (defun vhdl-template-footer () |
| 9868 | "Insert a VHDL file footer." |
| 9869 | (interactive) |
| 9870 | (unless (equal vhdl-file-footer "") |
| 9871 | (let (pos) |
| 9872 | (save-excursion |
| 9873 | (goto-char (point-max)) |
| 9874 | (setq pos (point-marker)) |
| 9875 | (vhdl-insert-string-or-file vhdl-file-footer) |
| 9876 | (unless (= (preceding-char) ?\n) |
| 9877 | (insert "\n"))) |
| 9878 | (vhdl-template-replace-header-keywords pos (point-max-marker))))) |
| 9879 | |
| 9880 | (defun vhdl-template-replace-header-keywords (beg end &optional file-title |
| 9881 | is-model) |
| 9882 | "Replace keywords in header and footer." |
| 9883 | (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) "")) |
| 9884 | (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) "")) |
| 9885 | pos) |
| 9886 | (vhdl-prepare-search-2 |
| 9887 | (save-excursion |
| 9888 | (goto-char beg) |
| 9889 | (while (search-forward "<projectdesc>" end t) |
| 9890 | (replace-match project-desc t t)) |
| 9891 | (goto-char beg) |
| 9892 | (while (search-forward "<filename>" end t) |
| 9893 | (replace-match (buffer-name) t t)) |
| 9894 | (goto-char beg) |
| 9895 | (while (search-forward "<copyright>" end t) |
| 9896 | (replace-match vhdl-copyright-string t t)) |
| 9897 | (goto-char beg) |
| 9898 | (while (search-forward "<author>" end t) |
| 9899 | (replace-match "" t t) |
| 9900 | (insert (user-full-name)) |
| 9901 | (when user-mail-address (insert " <" user-mail-address ">"))) |
| 9902 | (goto-char beg) |
| 9903 | (while (search-forward "<login>" end t) |
| 9904 | (replace-match (user-login-name) t t)) |
| 9905 | (goto-char beg) |
| 9906 | (while (search-forward "<project>" end t) |
| 9907 | (replace-match project-title t t)) |
| 9908 | (goto-char beg) |
| 9909 | (while (search-forward "<company>" end t) |
| 9910 | (replace-match vhdl-company-name t t)) |
| 9911 | (goto-char beg) |
| 9912 | (while (search-forward "<platform>" end t) |
| 9913 | (replace-match vhdl-platform-spec t t)) |
| 9914 | (goto-char beg) |
| 9915 | (while (search-forward "<standard>" end t) |
| 9916 | (replace-match |
| 9917 | (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") |
| 9918 | ((vhdl-standard-p '93) "'93")) |
| 9919 | (when (vhdl-standard-p 'ams) ", VHDL-AMS") |
| 9920 | (when (vhdl-standard-p 'math) ", Math Packages")) t t)) |
| 9921 | (goto-char beg) |
| 9922 | ;; Replace <RCS> with $, so that RCS for the source is |
| 9923 | ;; not over-enthusiastic with replacements |
| 9924 | (while (search-forward "<RCS>" end t) |
| 9925 | (replace-match "$" nil t)) |
| 9926 | (goto-char beg) |
| 9927 | (while (search-forward "<date>" end t) |
| 9928 | (replace-match "" t t) |
| 9929 | (vhdl-template-insert-date)) |
| 9930 | (goto-char beg) |
| 9931 | (while (search-forward "<year>" end t) |
| 9932 | (replace-match (format-time-string "%Y" nil) t t)) |
| 9933 | (goto-char beg) |
| 9934 | (when file-title |
| 9935 | (while (search-forward "<title string>" end t) |
| 9936 | (replace-match file-title t t)) |
| 9937 | (goto-char beg)) |
| 9938 | (let (string) |
| 9939 | (while |
| 9940 | (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) |
| 9941 | (setq string (read-string (concat (match-string 1) ": "))) |
| 9942 | (replace-match string t t))) |
| 9943 | (goto-char beg) |
| 9944 | (when (and (not is-model) (search-forward "<cursor>" end t)) |
| 9945 | (replace-match "" t t) |
| 9946 | (setq pos (point)))) |
| 9947 | (when pos (goto-char pos)) |
| 9948 | (unless is-model |
| 9949 | (when (or (not project-title) (equal project-title "")) |
| 9950 | (message "You can specify a project title in user option `vhdl-project-alist'")) |
| 9951 | (when (or (not project-desc) (equal project-desc "")) |
| 9952 | (message "You can specify a project description in user option `vhdl-project-alist'")) |
| 9953 | (when (equal vhdl-platform-spec "") |
| 9954 | (message "You can specify a platform in user option `vhdl-platform-spec'")) |
| 9955 | (when (equal vhdl-company-name "") |
| 9956 | (message "You can specify a company name in user option `vhdl-company-name'")))))) |
| 9957 | |
| 9958 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 9959 | ;; Comment templates and functions |
| 9960 | |
| 9961 | (defun vhdl-comment-indent () |
| 9962 | "Indent comments." |
| 9963 | (let* ((position (point)) |
| 9964 | (col |
| 9965 | (progn |
| 9966 | (forward-line -1) |
| 9967 | (if (re-search-forward "--" position t) |
| 9968 | (- (current-column) 2) ; existing comment at bol stays there |
| 9969 | (goto-char position) |
| 9970 | (skip-chars-backward " \t") |
| 9971 | (max comment-column ; else indent to comment column |
| 9972 | (1+ (current-column))))))) ; except leave at least one space |
| 9973 | (goto-char position) |
| 9974 | col)) |
| 9975 | |
| 9976 | (defun vhdl-comment-insert () |
| 9977 | "Start a comment at the end of the line. |
| 9978 | If on line with code, indent at least `comment-column'. |
| 9979 | If starting after end-comment-column, start a new line." |
| 9980 | (interactive) |
| 9981 | (when (> (current-column) end-comment-column) (newline-and-indent)) |
| 9982 | (if (or (looking-at "\\s-*$") ; end of line |
| 9983 | (and (not unread-command-events) ; called with key binding or menu |
| 9984 | (not (end-of-line)))) |
| 9985 | (let (margin) |
| 9986 | (while (= (preceding-char) ?-) (delete-char -1)) |
| 9987 | (setq margin (current-column)) |
| 9988 | (delete-horizontal-space) |
| 9989 | (if (bolp) |
| 9990 | (progn (indent-to margin) (insert "--")) |
| 9991 | (insert " ") |
| 9992 | (indent-to comment-column) |
| 9993 | (insert "--")) |
| 9994 | (if (not unread-command-events) (insert " "))) |
| 9995 | ;; else code following current point implies commenting out code |
| 9996 | (let (next-input code) |
| 9997 | (while (= (preceding-char) ?-) (delete-char -2)) |
| 9998 | (while (= (setq next-input (read-char)) 13) ; CR |
| 9999 | (insert "--") ; or have a space after it? |
| 10000 | (forward-char -2) |
| 10001 | (forward-line 1) |
| 10002 | (message "Enter CR if commenting out a line of code.") |
| 10003 | (setq code t)) |
| 10004 | (unless code |
| 10005 | (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? |
| 10006 | (setq unread-command-events |
| 10007 | (list (vhdl-character-to-event next-input)))))) ; pushback the char |
| 10008 | |
| 10009 | (defun vhdl-comment-display (&optional line-exists) |
| 10010 | "Add 2 comment lines at the current indent, making a display comment." |
| 10011 | (interactive) |
| 10012 | (let ((margin (current-indentation))) |
| 10013 | (unless line-exists (vhdl-comment-display-line)) |
| 10014 | (insert "\n") (indent-to margin) |
| 10015 | (insert "\n") (indent-to margin) |
| 10016 | (vhdl-comment-display-line) |
| 10017 | (end-of-line -0) |
| 10018 | (insert "-- "))) |
| 10019 | |
| 10020 | (defun vhdl-comment-display-line () |
| 10021 | "Displays one line of dashes." |
| 10022 | (interactive) |
| 10023 | (while (= (preceding-char) ?-) (delete-char -2)) |
| 10024 | (let* ((col (current-column)) |
| 10025 | (len (- end-comment-column col))) |
| 10026 | (insert-char ?- len))) |
| 10027 | |
| 10028 | (defun vhdl-comment-append-inline () |
| 10029 | "Append empty inline comment to current line." |
| 10030 | (interactive) |
| 10031 | (end-of-line) |
| 10032 | (delete-horizontal-space) |
| 10033 | (insert " ") |
| 10034 | (indent-to comment-column) |
| 10035 | (insert "-- ")) |
| 10036 | |
| 10037 | (defun vhdl-comment-insert-inline (&optional string always-insert) |
| 10038 | "Insert inline comment." |
| 10039 | (when (or (and string (or vhdl-self-insert-comments always-insert)) |
| 10040 | (and (not string) vhdl-prompt-for-comments)) |
| 10041 | (let ((position (point))) |
| 10042 | (insert " ") |
| 10043 | (indent-to comment-column) |
| 10044 | (insert "-- ") |
| 10045 | (if (not (or (and string (progn (insert string) t)) |
| 10046 | (vhdl-template-field "[comment]" nil t))) |
| 10047 | (delete-region position (point)) |
| 10048 | (while (= (preceding-char) ?\ ) (delete-char -1)) |
| 10049 | ;; (when (> (current-column) end-comment-column) |
| 10050 | ;; (setq position (point-marker)) |
| 10051 | ;; (re-search-backward "-- ") |
| 10052 | ;; (insert "\n") |
| 10053 | ;; (indent-to comment-column) |
| 10054 | ;; (goto-char position)) |
| 10055 | )))) |
| 10056 | |
| 10057 | (defun vhdl-comment-block () |
| 10058 | "Insert comment for code block." |
| 10059 | (when vhdl-prompt-for-comments |
| 10060 | (let ((final-pos (point-marker))) |
| 10061 | (vhdl-prepare-search-2 |
| 10062 | (when (and (re-search-backward "^\\s-*begin\\>" nil t) |
| 10063 | (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) |
| 10064 | (let (margin) |
| 10065 | (back-to-indentation) |
| 10066 | (setq margin (current-column)) |
| 10067 | (end-of-line -0) |
| 10068 | (if (bobp) |
| 10069 | (progn (insert "\n") (forward-line -1)) |
| 10070 | (insert "\n")) |
| 10071 | (indent-to margin) |
| 10072 | (insert "-- purpose: ") |
| 10073 | (unless (vhdl-template-field "[description]" nil t) |
| 10074 | (vhdl-line-kill-entire))))) |
| 10075 | (goto-char final-pos)))) |
| 10076 | |
| 10077 | (defun vhdl-comment-uncomment-region (beg end &optional arg) |
| 10078 | "Comment out region if not commented out, uncomment otherwise." |
| 10079 | (interactive "r\nP") |
| 10080 | (save-excursion |
| 10081 | (goto-char (1- end)) |
| 10082 | (end-of-line) |
| 10083 | (setq end (point-marker)) |
| 10084 | (goto-char beg) |
| 10085 | (beginning-of-line) |
| 10086 | (setq beg (point)) |
| 10087 | (if (looking-at comment-start) |
| 10088 | (comment-region beg end '(4)) |
| 10089 | (comment-region beg end)))) |
| 10090 | |
| 10091 | (defun vhdl-comment-uncomment-line (&optional arg) |
| 10092 | "Comment out line if not commented out, uncomment otherwise." |
| 10093 | (interactive "p") |
| 10094 | (save-excursion |
| 10095 | (beginning-of-line) |
| 10096 | (let ((position (point))) |
| 10097 | (forward-line (or arg 1)) |
| 10098 | (vhdl-comment-uncomment-region position (point))))) |
| 10099 | |
| 10100 | (defun vhdl-comment-kill-region (beg end) |
| 10101 | "Kill comments in region." |
| 10102 | (interactive "r") |
| 10103 | (save-excursion |
| 10104 | (goto-char end) |
| 10105 | (setq end (point-marker)) |
| 10106 | (goto-char beg) |
| 10107 | (beginning-of-line) |
| 10108 | (while (< (point) end) |
| 10109 | (if (looking-at "^\\(\\s-*--.*\n\\)") |
| 10110 | (progn (delete-region (match-beginning 1) (match-end 1))) |
| 10111 | (beginning-of-line 2))))) |
| 10112 | |
| 10113 | (defun vhdl-comment-kill-inline-region (beg end) |
| 10114 | "Kill inline comments in region." |
| 10115 | (interactive "r") |
| 10116 | (save-excursion |
| 10117 | (goto-char end) |
| 10118 | (setq end (point-marker)) |
| 10119 | (goto-char beg) |
| 10120 | (beginning-of-line) |
| 10121 | (while (< (point) end) |
| 10122 | (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$") |
| 10123 | (delete-region (match-beginning 1) (match-end 1))) |
| 10124 | (beginning-of-line 2)))) |
| 10125 | |
| 10126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10127 | ;; Subtemplates |
| 10128 | |
| 10129 | (defun vhdl-template-begin-end (construct name margin &optional empty-lines) |
| 10130 | "Insert a begin ... end pair with optional name after the end. |
| 10131 | Point is left between them." |
| 10132 | (let (position) |
| 10133 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10134 | (indent-to margin) |
| 10135 | (vhdl-insert-keyword "BEGIN") |
| 10136 | (when (and (or construct name) vhdl-self-insert-comments) |
| 10137 | (insert " --") |
| 10138 | (when construct (insert " ") (vhdl-insert-keyword construct)) |
| 10139 | (when name (insert " " name))) |
| 10140 | (insert "\n") |
| 10141 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10142 | (indent-to (+ margin vhdl-basic-offset)) |
| 10143 | (setq position (point)) |
| 10144 | (insert "\n") |
| 10145 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10146 | (indent-to margin) |
| 10147 | (vhdl-insert-keyword "END") |
| 10148 | (when construct (insert " ") (vhdl-insert-keyword construct)) |
| 10149 | (insert (if name (concat " " name) "") ";") |
| 10150 | (goto-char position))) |
| 10151 | |
| 10152 | (defun vhdl-template-argument-list (&optional is-function) |
| 10153 | "Read from user a procedure or function argument list." |
| 10154 | (insert " (") |
| 10155 | (let ((margin (current-column)) |
| 10156 | (start (point)) |
| 10157 | (end-pos (point)) |
| 10158 | not-empty interface semicolon-pos) |
| 10159 | (unless vhdl-argument-list-indent |
| 10160 | (setq margin (+ (current-indentation) vhdl-basic-offset)) |
| 10161 | (insert "\n") |
| 10162 | (indent-to margin)) |
| 10163 | (setq interface (vhdl-template-field |
| 10164 | (concat "[CONSTANT | SIGNAL" |
| 10165 | (unless is-function " | VARIABLE") "]") " " t)) |
| 10166 | (while (vhdl-template-field "[names]" nil t) |
| 10167 | (setq not-empty t) |
| 10168 | (insert " : ") |
| 10169 | (unless is-function |
| 10170 | (if (and interface (equal (upcase interface) "CONSTANT")) |
| 10171 | (vhdl-insert-keyword "IN ") |
| 10172 | (vhdl-template-field "[IN | OUT | INOUT]" " " t))) |
| 10173 | (vhdl-template-field "type") |
| 10174 | (setq semicolon-pos (point)) |
| 10175 | (insert ";") |
| 10176 | (vhdl-comment-insert-inline) |
| 10177 | (setq end-pos (point)) |
| 10178 | (insert "\n") |
| 10179 | (indent-to margin) |
| 10180 | (setq interface (vhdl-template-field |
| 10181 | (concat "[CONSTANT | SIGNAL" |
| 10182 | (unless is-function " | VARIABLE") "]") " " t))) |
| 10183 | (delete-region end-pos (point)) |
| 10184 | (when semicolon-pos (goto-char semicolon-pos)) |
| 10185 | (if not-empty |
| 10186 | (progn (delete-char 1) (insert ")")) |
| 10187 | (delete-char -2)))) |
| 10188 | |
| 10189 | (defun vhdl-template-generic-list (optional &optional no-value) |
| 10190 | "Read from user a generic spec argument list." |
| 10191 | (let (margin |
| 10192 | (start (point))) |
| 10193 | (vhdl-insert-keyword "GENERIC (") |
| 10194 | (setq margin (current-column)) |
| 10195 | (unless vhdl-argument-list-indent |
| 10196 | (let ((position (point))) |
| 10197 | (back-to-indentation) |
| 10198 | (setq margin (+ (current-column) vhdl-basic-offset)) |
| 10199 | (goto-char position) |
| 10200 | (insert "\n") |
| 10201 | (indent-to margin))) |
| 10202 | (let ((vhdl-generics (vhdl-template-field |
| 10203 | (concat (and optional "[") "name" |
| 10204 | (and no-value "s") (and optional "]")) |
| 10205 | nil optional))) |
| 10206 | (if (not vhdl-generics) |
| 10207 | (if optional |
| 10208 | (progn (vhdl-line-kill-entire) (end-of-line -0) |
| 10209 | (unless vhdl-argument-list-indent |
| 10210 | (vhdl-line-kill-entire) (end-of-line -0))) |
| 10211 | (vhdl-template-undo start (point)) |
| 10212 | nil ) |
| 10213 | (insert " : ") |
| 10214 | (let (semicolon-pos end-pos) |
| 10215 | (while vhdl-generics |
| 10216 | (vhdl-template-field "type") |
| 10217 | (if no-value |
| 10218 | (progn (setq semicolon-pos (point)) |
| 10219 | (insert ";")) |
| 10220 | (insert " := ") |
| 10221 | (unless (vhdl-template-field "[value]" nil t) |
| 10222 | (delete-char -4)) |
| 10223 | (setq semicolon-pos (point)) |
| 10224 | (insert ";")) |
| 10225 | (vhdl-comment-insert-inline) |
| 10226 | (setq end-pos (point)) |
| 10227 | (insert "\n") |
| 10228 | (indent-to margin) |
| 10229 | (setq vhdl-generics (vhdl-template-field |
| 10230 | (concat "[name" (and no-value "s") "]") |
| 10231 | " : " t))) |
| 10232 | (delete-region end-pos (point)) |
| 10233 | (goto-char semicolon-pos) |
| 10234 | (insert ")") |
| 10235 | (end-of-line) |
| 10236 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 10237 | t))))) |
| 10238 | |
| 10239 | (defun vhdl-template-port-list (optional) |
| 10240 | "Read from user a port spec argument list." |
| 10241 | (let ((start (point)) |
| 10242 | margin vhdl-ports object) |
| 10243 | (vhdl-insert-keyword "PORT (") |
| 10244 | (setq margin (current-column)) |
| 10245 | (unless vhdl-argument-list-indent |
| 10246 | (let ((position (point))) |
| 10247 | (back-to-indentation) |
| 10248 | (setq margin (+ (current-column) vhdl-basic-offset)) |
| 10249 | (goto-char position) |
| 10250 | (insert "\n") |
| 10251 | (indent-to margin))) |
| 10252 | (when (vhdl-standard-p 'ams) |
| 10253 | (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" |
| 10254 | " " t))) |
| 10255 | (setq vhdl-ports (vhdl-template-field |
| 10256 | (concat (and optional "[") "names" (and optional "]")) |
| 10257 | nil optional)) |
| 10258 | (if (not vhdl-ports) |
| 10259 | (if optional |
| 10260 | (progn (vhdl-line-kill-entire) (end-of-line -0) |
| 10261 | (unless vhdl-argument-list-indent |
| 10262 | (vhdl-line-kill-entire) (end-of-line -0))) |
| 10263 | (vhdl-template-undo start (point)) |
| 10264 | nil) |
| 10265 | (insert " : ") |
| 10266 | (let (semicolon-pos end-pos) |
| 10267 | (while vhdl-ports |
| 10268 | (cond ((or (null object) (equal "SIGNAL" (upcase object))) |
| 10269 | (vhdl-template-field "IN | OUT | INOUT" " ")) |
| 10270 | ((equal "QUANTITY" (upcase object)) |
| 10271 | (vhdl-template-field "[IN | OUT]" " " t))) |
| 10272 | (vhdl-template-field |
| 10273 | (if (and object (equal "TERMINAL" (upcase object))) |
| 10274 | "nature" "type")) |
| 10275 | (setq semicolon-pos (point)) |
| 10276 | (insert ";") |
| 10277 | (vhdl-comment-insert-inline) |
| 10278 | (setq end-pos (point)) |
| 10279 | (insert "\n") |
| 10280 | (indent-to margin) |
| 10281 | (when (vhdl-standard-p 'ams) |
| 10282 | (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" |
| 10283 | " " t))) |
| 10284 | (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) |
| 10285 | (delete-region end-pos (point)) |
| 10286 | (goto-char semicolon-pos) |
| 10287 | (insert ")") |
| 10288 | (end-of-line) |
| 10289 | (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) |
| 10290 | t)))) |
| 10291 | |
| 10292 | (defun vhdl-template-generate-body (margin label) |
| 10293 | "Insert body for generate template." |
| 10294 | (vhdl-insert-keyword " GENERATE") |
| 10295 | ; (if (not (vhdl-standard-p '87)) |
| 10296 | ; (vhdl-template-begin-end "GENERATE" label margin) |
| 10297 | (insert "\n\n") |
| 10298 | (indent-to margin) |
| 10299 | (vhdl-insert-keyword "END GENERATE ") |
| 10300 | (insert label ";") |
| 10301 | (end-of-line 0) |
| 10302 | (indent-to (+ margin vhdl-basic-offset))) |
| 10303 | |
| 10304 | (defun vhdl-template-insert-date () |
| 10305 | "Insert date in appropriate format." |
| 10306 | (interactive) |
| 10307 | (insert |
| 10308 | (cond |
| 10309 | ;; 'american, 'european, 'scientific kept for backward compatibility |
| 10310 | ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) |
| 10311 | ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) |
| 10312 | ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) |
| 10313 | (t (format-time-string vhdl-date-format nil))))) |
| 10314 | |
| 10315 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10316 | ;; Help functions |
| 10317 | |
| 10318 | (defun vhdl-electric-space (count) |
| 10319 | "Expand abbreviations and self-insert space(s), do indent-new-comment-line |
| 10320 | if in comment and past end-comment-column." |
| 10321 | (interactive "p") |
| 10322 | (cond ((vhdl-in-comment-p) |
| 10323 | (self-insert-command count) |
| 10324 | (cond ((>= (current-column) (+ 2 end-comment-column)) |
| 10325 | (backward-char 1) |
| 10326 | (skip-chars-backward "^ \t\n") |
| 10327 | (indent-new-comment-line) |
| 10328 | (skip-chars-forward "^ \t\n") |
| 10329 | (forward-char 1)) |
| 10330 | ((>= (current-column) end-comment-column) |
| 10331 | (indent-new-comment-line)) |
| 10332 | (t nil))) |
| 10333 | ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) |
| 10334 | (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) |
| 10335 | (vhdl-prepare-search-1 |
| 10336 | (or (expand-abbrev) (vhdl-fix-case-word -1))) |
| 10337 | (self-insert-command count)) |
| 10338 | (t (self-insert-command count)))) |
| 10339 | |
| 10340 | (defun vhdl-template-field (prompt &optional follow-string optional |
| 10341 | begin end is-string default) |
| 10342 | "Prompt for string and insert it in buffer with optional FOLLOW-STRING. |
| 10343 | If OPTIONAL is nil, the prompt is left if an empty string is inserted. If |
| 10344 | an empty string is inserted, return nil and call `vhdl-template-undo' for |
| 10345 | the region between BEGIN and END. IS-STRING indicates whether a string |
| 10346 | with double-quotes is to be inserted. DEFAULT specifies a default string." |
| 10347 | (let ((position (point)) |
| 10348 | string) |
| 10349 | (insert "<" prompt ">") |
| 10350 | (setq string |
| 10351 | (condition-case () |
| 10352 | (read-from-minibuffer (concat prompt ": ") |
| 10353 | (or (and is-string '("\"\"" . 2)) default) |
| 10354 | vhdl-minibuffer-local-map) |
| 10355 | (quit (if (and optional begin end) |
| 10356 | (progn (beep) "") |
| 10357 | (keyboard-quit))))) |
| 10358 | (when (or (not (equal string "")) optional) |
| 10359 | (delete-region position (point))) |
| 10360 | (when (and (equal string "") optional begin end) |
| 10361 | (vhdl-template-undo begin end) |
| 10362 | (message "Template aborted")) |
| 10363 | (unless (equal string "") |
| 10364 | (insert string) |
| 10365 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords |
| 10366 | vhdl-keywords-regexp) |
| 10367 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types |
| 10368 | vhdl-types-regexp) |
| 10369 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes |
| 10370 | (concat "'" vhdl-attributes-regexp)) |
| 10371 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values |
| 10372 | vhdl-enum-values-regexp)) |
| 10373 | (when (or (not (equal string "")) (not optional)) |
| 10374 | (insert (or follow-string ""))) |
| 10375 | (if (equal string "") nil string))) |
| 10376 | |
| 10377 | (defun vhdl-decision-query (string prompt &optional optional) |
| 10378 | "Query a decision from the user." |
| 10379 | (let ((start (point))) |
| 10380 | (when string (vhdl-insert-keyword (concat string " "))) |
| 10381 | (message "%s" (or prompt "")) |
| 10382 | (let ((char (read-char))) |
| 10383 | (delete-region start (point)) |
| 10384 | (if (and optional (eq char ?\r)) |
| 10385 | (progn (insert " ") |
| 10386 | (unexpand-abbrev) |
| 10387 | (throw 'abort "ERROR: Template aborted")) |
| 10388 | char)))) |
| 10389 | |
| 10390 | (defun vhdl-insert-keyword (keyword) |
| 10391 | "Insert KEYWORD and adjust case." |
| 10392 | (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) |
| 10393 | |
| 10394 | (defun vhdl-case-keyword (keyword) |
| 10395 | "Adjust case of KEYWORD." |
| 10396 | (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) |
| 10397 | |
| 10398 | (defun vhdl-case-word (num) |
| 10399 | "Adjust case of following NUM words." |
| 10400 | (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) |
| 10401 | |
| 10402 | (defun vhdl-minibuffer-tab (&optional prefix-arg) |
| 10403 | "If preceding character is part of a word or a paren then hippie-expand, |
| 10404 | else insert tab (used for word completion in VHDL minibuffer)." |
| 10405 | (interactive "P") |
| 10406 | (cond |
| 10407 | ;; expand word |
| 10408 | ((= (char-syntax (preceding-char)) ?w) |
| 10409 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 10410 | (case-replace nil) |
| 10411 | (hippie-expand-only-buffers |
| 10412 | (or (and (boundp 'hippie-expand-only-buffers) |
| 10413 | hippie-expand-only-buffers) |
| 10414 | '(vhdl-mode)))) |
| 10415 | (vhdl-expand-abbrev prefix-arg))) |
| 10416 | ;; expand parenthesis |
| 10417 | ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) |
| 10418 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 10419 | (case-replace nil)) |
| 10420 | (vhdl-expand-paren prefix-arg))) |
| 10421 | ;; insert tab |
| 10422 | (t (insert-tab)))) |
| 10423 | |
| 10424 | (defun vhdl-template-search-prompt () |
| 10425 | "Search for left out template prompts and query again." |
| 10426 | (interactive) |
| 10427 | (vhdl-prepare-search-2 |
| 10428 | (when (or (re-search-forward |
| 10429 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) |
| 10430 | (re-search-backward |
| 10431 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) |
| 10432 | (let ((string (match-string 1))) |
| 10433 | (replace-match "") |
| 10434 | (vhdl-template-field string))))) |
| 10435 | |
| 10436 | (defun vhdl-template-undo (begin end) |
| 10437 | "Undo aborted template by deleting region and unexpanding the keyword." |
| 10438 | (cond (vhdl-template-invoked-by-hook |
| 10439 | (goto-char end) |
| 10440 | (insert " ") |
| 10441 | (delete-region begin end) |
| 10442 | (unexpand-abbrev)) |
| 10443 | (t (delete-region begin end)))) |
| 10444 | |
| 10445 | (defun vhdl-insert-string-or-file (string) |
| 10446 | "Insert STRING or file contents if STRING is an existing file name." |
| 10447 | (unless (equal string "") |
| 10448 | (let ((file-name |
| 10449 | (progn (string-match "^\\([^\n]+\\)" string) |
| 10450 | (vhdl-resolve-env-variable (match-string 1 string))))) |
| 10451 | (if (file-exists-p file-name) |
| 10452 | (forward-char (cadr (insert-file-contents file-name))) |
| 10453 | (insert string))))) |
| 10454 | |
| 10455 | (defun vhdl-beginning-of-block () |
| 10456 | "Move cursor to the beginning of the enclosing block." |
| 10457 | (let (pos) |
| 10458 | (save-excursion |
| 10459 | (beginning-of-line) |
| 10460 | ;; search backward for block beginning or end |
| 10461 | (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t)) |
| 10462 | ;; not consider subprogram declarations |
| 10463 | (or (and (match-string 5) |
| 10464 | (save-match-data |
| 10465 | (save-excursion |
| 10466 | (goto-char (match-end 5)) |
| 10467 | (forward-word 1) |
| 10468 | (vhdl-forward-syntactic-ws) |
| 10469 | (when (looking-at "(") |
| 10470 | (forward-sexp)) |
| 10471 | (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) |
| 10472 | (match-string 1))) |
| 10473 | ;; not consider configuration specifications |
| 10474 | (and (match-string 6) |
| 10475 | (save-match-data |
| 10476 | (save-excursion |
| 10477 | (vhdl-end-of-block) |
| 10478 | (beginning-of-line) |
| 10479 | (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) |
| 10480 | (match-string 2)) |
| 10481 | ;; skip subblock if block end found |
| 10482 | (vhdl-beginning-of-block))) |
| 10483 | (when pos (goto-char pos)))) |
| 10484 | |
| 10485 | (defun vhdl-end-of-block () |
| 10486 | "Move cursor to the end of the enclosing block." |
| 10487 | (let (pos) |
| 10488 | (save-excursion |
| 10489 | (end-of-line) |
| 10490 | ;; search forward for block beginning or end |
| 10491 | (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t)) |
| 10492 | ;; not consider subprogram declarations |
| 10493 | (or (and (match-string 5) |
| 10494 | (save-match-data |
| 10495 | (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) |
| 10496 | (match-string 1))) |
| 10497 | ;; not consider configuration specifications |
| 10498 | (and (match-string 6) |
| 10499 | (save-match-data |
| 10500 | (save-excursion |
| 10501 | (vhdl-end-of-block) |
| 10502 | (beginning-of-line) |
| 10503 | (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) |
| 10504 | (not (match-string 2))) |
| 10505 | ;; skip subblock if block beginning found |
| 10506 | (vhdl-end-of-block))) |
| 10507 | (when pos (goto-char pos)))) |
| 10508 | |
| 10509 | (defun vhdl-sequential-statement-p () |
| 10510 | "Check if point is within sequential statement part." |
| 10511 | (let ((start (point))) |
| 10512 | (save-excursion |
| 10513 | (vhdl-prepare-search-2 |
| 10514 | ;; is sequential statement if ... |
| 10515 | (and (re-search-backward "^\\s-*begin\\>" nil t) |
| 10516 | ;; ... point is between "begin" and "end" of ... |
| 10517 | (progn (vhdl-end-of-block) |
| 10518 | (< start (point))) |
| 10519 | ;; ... a sequential block |
| 10520 | (progn (vhdl-beginning-of-block) |
| 10521 | (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>"))))))) |
| 10522 | |
| 10523 | (defun vhdl-in-argument-list-p () |
| 10524 | "Check if within an argument list." |
| 10525 | (save-excursion |
| 10526 | (vhdl-prepare-search-2 |
| 10527 | (or (string-match "arglist" |
| 10528 | (format "%s" (caar (vhdl-get-syntactic-context)))) |
| 10529 | (progn (beginning-of-line) |
| 10530 | (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) |
| 10531 | |
| 10532 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10533 | ;; Abbrev hooks |
| 10534 | |
| 10535 | (defun vhdl-hooked-abbrev (func) |
| 10536 | "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, |
| 10537 | but not if inside a comment or quote." |
| 10538 | (if (or (vhdl-in-literal) |
| 10539 | (save-excursion |
| 10540 | (forward-word -1) |
| 10541 | (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) |
| 10542 | (progn |
| 10543 | (insert " ") |
| 10544 | (unexpand-abbrev) |
| 10545 | (delete-char -1)) |
| 10546 | (if (not vhdl-electric-mode) |
| 10547 | (progn |
| 10548 | (insert " ") |
| 10549 | (unexpand-abbrev) |
| 10550 | (backward-word 1) |
| 10551 | (vhdl-case-word 1) |
| 10552 | (delete-char 1)) |
| 10553 | (let ((invoke-char last-command-event) |
| 10554 | (abbrev-mode -1) |
| 10555 | (vhdl-template-invoked-by-hook t)) |
| 10556 | (let ((caught (catch 'abort |
| 10557 | (funcall func)))) |
| 10558 | (when (stringp caught) (message "%s" caught))) |
| 10559 | (when (= invoke-char ?-) (setq abbrev-start-location (point))) |
| 10560 | ;; delete CR which is still in event queue |
| 10561 | (if (fboundp 'enqueue-eval-event) |
| 10562 | (enqueue-eval-event 'delete-char -1) |
| 10563 | (setq unread-command-events ; push back a delete char |
| 10564 | (list (vhdl-character-to-event ?\177)))))))) |
| 10565 | |
| 10566 | (defun vhdl-template-alias-hook () |
| 10567 | (vhdl-hooked-abbrev 'vhdl-template-alias)) |
| 10568 | (defun vhdl-template-architecture-hook () |
| 10569 | (vhdl-hooked-abbrev 'vhdl-template-architecture)) |
| 10570 | (defun vhdl-template-assert-hook () |
| 10571 | (vhdl-hooked-abbrev 'vhdl-template-assert)) |
| 10572 | (defun vhdl-template-attribute-hook () |
| 10573 | (vhdl-hooked-abbrev 'vhdl-template-attribute)) |
| 10574 | (defun vhdl-template-block-hook () |
| 10575 | (vhdl-hooked-abbrev 'vhdl-template-block)) |
| 10576 | (defun vhdl-template-break-hook () |
| 10577 | (vhdl-hooked-abbrev 'vhdl-template-break)) |
| 10578 | (defun vhdl-template-case-hook () |
| 10579 | (vhdl-hooked-abbrev 'vhdl-template-case)) |
| 10580 | (defun vhdl-template-component-hook () |
| 10581 | (vhdl-hooked-abbrev 'vhdl-template-component)) |
| 10582 | (defun vhdl-template-instance-hook () |
| 10583 | (vhdl-hooked-abbrev 'vhdl-template-instance)) |
| 10584 | (defun vhdl-template-conditional-signal-asst-hook () |
| 10585 | (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) |
| 10586 | (defun vhdl-template-configuration-hook () |
| 10587 | (vhdl-hooked-abbrev 'vhdl-template-configuration)) |
| 10588 | (defun vhdl-template-constant-hook () |
| 10589 | (vhdl-hooked-abbrev 'vhdl-template-constant)) |
| 10590 | (defun vhdl-template-disconnect-hook () |
| 10591 | (vhdl-hooked-abbrev 'vhdl-template-disconnect)) |
| 10592 | (defun vhdl-template-display-comment-hook () |
| 10593 | (vhdl-hooked-abbrev 'vhdl-comment-display)) |
| 10594 | (defun vhdl-template-else-hook () |
| 10595 | (vhdl-hooked-abbrev 'vhdl-template-else)) |
| 10596 | (defun vhdl-template-elsif-hook () |
| 10597 | (vhdl-hooked-abbrev 'vhdl-template-elsif)) |
| 10598 | (defun vhdl-template-entity-hook () |
| 10599 | (vhdl-hooked-abbrev 'vhdl-template-entity)) |
| 10600 | (defun vhdl-template-exit-hook () |
| 10601 | (vhdl-hooked-abbrev 'vhdl-template-exit)) |
| 10602 | (defun vhdl-template-file-hook () |
| 10603 | (vhdl-hooked-abbrev 'vhdl-template-file)) |
| 10604 | (defun vhdl-template-for-hook () |
| 10605 | (vhdl-hooked-abbrev 'vhdl-template-for)) |
| 10606 | (defun vhdl-template-function-hook () |
| 10607 | (vhdl-hooked-abbrev 'vhdl-template-function)) |
| 10608 | (defun vhdl-template-generic-hook () |
| 10609 | (vhdl-hooked-abbrev 'vhdl-template-generic)) |
| 10610 | (defun vhdl-template-group-hook () |
| 10611 | (vhdl-hooked-abbrev 'vhdl-template-group)) |
| 10612 | (defun vhdl-template-library-hook () |
| 10613 | (vhdl-hooked-abbrev 'vhdl-template-library)) |
| 10614 | (defun vhdl-template-limit-hook () |
| 10615 | (vhdl-hooked-abbrev 'vhdl-template-limit)) |
| 10616 | (defun vhdl-template-if-hook () |
| 10617 | (vhdl-hooked-abbrev 'vhdl-template-if)) |
| 10618 | (defun vhdl-template-bare-loop-hook () |
| 10619 | (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) |
| 10620 | (defun vhdl-template-map-hook () |
| 10621 | (vhdl-hooked-abbrev 'vhdl-template-map)) |
| 10622 | (defun vhdl-template-nature-hook () |
| 10623 | (vhdl-hooked-abbrev 'vhdl-template-nature)) |
| 10624 | (defun vhdl-template-next-hook () |
| 10625 | (vhdl-hooked-abbrev 'vhdl-template-next)) |
| 10626 | (defun vhdl-template-others-hook () |
| 10627 | (vhdl-hooked-abbrev 'vhdl-template-others)) |
| 10628 | (defun vhdl-template-package-hook () |
| 10629 | (vhdl-hooked-abbrev 'vhdl-template-package)) |
| 10630 | (defun vhdl-template-port-hook () |
| 10631 | (vhdl-hooked-abbrev 'vhdl-template-port)) |
| 10632 | (defun vhdl-template-procedural-hook () |
| 10633 | (vhdl-hooked-abbrev 'vhdl-template-procedural)) |
| 10634 | (defun vhdl-template-procedure-hook () |
| 10635 | (vhdl-hooked-abbrev 'vhdl-template-procedure)) |
| 10636 | (defun vhdl-template-process-hook () |
| 10637 | (vhdl-hooked-abbrev 'vhdl-template-process)) |
| 10638 | (defun vhdl-template-quantity-hook () |
| 10639 | (vhdl-hooked-abbrev 'vhdl-template-quantity)) |
| 10640 | (defun vhdl-template-report-hook () |
| 10641 | (vhdl-hooked-abbrev 'vhdl-template-report)) |
| 10642 | (defun vhdl-template-return-hook () |
| 10643 | (vhdl-hooked-abbrev 'vhdl-template-return)) |
| 10644 | (defun vhdl-template-selected-signal-asst-hook () |
| 10645 | (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) |
| 10646 | (defun vhdl-template-signal-hook () |
| 10647 | (vhdl-hooked-abbrev 'vhdl-template-signal)) |
| 10648 | (defun vhdl-template-subnature-hook () |
| 10649 | (vhdl-hooked-abbrev 'vhdl-template-subnature)) |
| 10650 | (defun vhdl-template-subtype-hook () |
| 10651 | (vhdl-hooked-abbrev 'vhdl-template-subtype)) |
| 10652 | (defun vhdl-template-terminal-hook () |
| 10653 | (vhdl-hooked-abbrev 'vhdl-template-terminal)) |
| 10654 | (defun vhdl-template-type-hook () |
| 10655 | (vhdl-hooked-abbrev 'vhdl-template-type)) |
| 10656 | (defun vhdl-template-use-hook () |
| 10657 | (vhdl-hooked-abbrev 'vhdl-template-use)) |
| 10658 | (defun vhdl-template-variable-hook () |
| 10659 | (vhdl-hooked-abbrev 'vhdl-template-variable)) |
| 10660 | (defun vhdl-template-wait-hook () |
| 10661 | (vhdl-hooked-abbrev 'vhdl-template-wait)) |
| 10662 | (defun vhdl-template-when-hook () |
| 10663 | (vhdl-hooked-abbrev 'vhdl-template-when)) |
| 10664 | (defun vhdl-template-while-loop-hook () |
| 10665 | (vhdl-hooked-abbrev 'vhdl-template-while-loop)) |
| 10666 | (defun vhdl-template-with-hook () |
| 10667 | (vhdl-hooked-abbrev 'vhdl-template-with)) |
| 10668 | (defun vhdl-template-and-hook () |
| 10669 | (vhdl-hooked-abbrev 'vhdl-template-and)) |
| 10670 | (defun vhdl-template-or-hook () |
| 10671 | (vhdl-hooked-abbrev 'vhdl-template-or)) |
| 10672 | (defun vhdl-template-nand-hook () |
| 10673 | (vhdl-hooked-abbrev 'vhdl-template-nand)) |
| 10674 | (defun vhdl-template-nor-hook () |
| 10675 | (vhdl-hooked-abbrev 'vhdl-template-nor)) |
| 10676 | (defun vhdl-template-xor-hook () |
| 10677 | (vhdl-hooked-abbrev 'vhdl-template-xor)) |
| 10678 | (defun vhdl-template-xnor-hook () |
| 10679 | (vhdl-hooked-abbrev 'vhdl-template-xnor)) |
| 10680 | (defun vhdl-template-not-hook () |
| 10681 | (vhdl-hooked-abbrev 'vhdl-template-not)) |
| 10682 | |
| 10683 | (defun vhdl-template-default-hook () |
| 10684 | (vhdl-hooked-abbrev 'vhdl-template-default)) |
| 10685 | (defun vhdl-template-default-indent-hook () |
| 10686 | (vhdl-hooked-abbrev 'vhdl-template-default-indent)) |
| 10687 | |
| 10688 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10689 | ;; Template insertion from completion list |
| 10690 | |
| 10691 | (defun vhdl-template-insert-construct (name) |
| 10692 | "Insert the built-in construct template with NAME." |
| 10693 | (interactive |
| 10694 | (list (let ((completion-ignore-case t)) |
| 10695 | (completing-read "Construct name: " |
| 10696 | vhdl-template-construct-alist nil t)))) |
| 10697 | (vhdl-template-insert-fun |
| 10698 | (cadr (assoc name vhdl-template-construct-alist)))) |
| 10699 | |
| 10700 | (defun vhdl-template-insert-package (name) |
| 10701 | "Insert the built-in package template with NAME." |
| 10702 | (interactive |
| 10703 | (list (let ((completion-ignore-case t)) |
| 10704 | (completing-read "Package name: " |
| 10705 | vhdl-template-package-alist nil t)))) |
| 10706 | (vhdl-template-insert-fun |
| 10707 | (cadr (assoc name vhdl-template-package-alist)))) |
| 10708 | |
| 10709 | (defun vhdl-template-insert-directive (name) |
| 10710 | "Insert the built-in directive template with NAME." |
| 10711 | (interactive |
| 10712 | (list (let ((completion-ignore-case t)) |
| 10713 | (completing-read "Directive name: " |
| 10714 | vhdl-template-directive-alist nil t)))) |
| 10715 | (vhdl-template-insert-fun |
| 10716 | (cadr (assoc name vhdl-template-directive-alist)))) |
| 10717 | |
| 10718 | (defun vhdl-template-insert-fun (fun) |
| 10719 | "Call FUN to insert a built-in template." |
| 10720 | (let ((caught (catch 'abort (when fun (funcall fun))))) |
| 10721 | (when (stringp caught) (message "%s" caught)))) |
| 10722 | |
| 10723 | |
| 10724 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10725 | ;;; Models |
| 10726 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10727 | |
| 10728 | (defun vhdl-model-insert (model-name) |
| 10729 | "Insert the user model with name MODEL-NAME." |
| 10730 | (interactive |
| 10731 | (let ((completion-ignore-case t)) |
| 10732 | (list (completing-read "Model name: " vhdl-model-alist)))) |
| 10733 | (indent-according-to-mode) |
| 10734 | (let ((start (point-marker)) |
| 10735 | (margin (current-indentation)) |
| 10736 | model position prompt string end) |
| 10737 | (vhdl-prepare-search-2 |
| 10738 | (when (setq model (assoc model-name vhdl-model-alist)) |
| 10739 | ;; insert model |
| 10740 | (beginning-of-line) |
| 10741 | (delete-horizontal-space) |
| 10742 | (goto-char start) |
| 10743 | (vhdl-insert-string-or-file (nth 1 model)) |
| 10744 | (setq end (point-marker)) |
| 10745 | ;; indent code |
| 10746 | (goto-char start) |
| 10747 | (beginning-of-line) |
| 10748 | (while (< (point) end) |
| 10749 | (unless (looking-at "^$") |
| 10750 | (insert-char ? margin)) |
| 10751 | (beginning-of-line 2)) |
| 10752 | (goto-char start) |
| 10753 | ;; insert clock |
| 10754 | (unless (equal "" vhdl-clock-name) |
| 10755 | (while (re-search-forward "<clock>" end t) |
| 10756 | (replace-match vhdl-clock-name))) |
| 10757 | (goto-char start) |
| 10758 | ;; insert reset |
| 10759 | (unless (equal "" vhdl-reset-name) |
| 10760 | (while (re-search-forward "<reset>" end t) |
| 10761 | (replace-match vhdl-reset-name))) |
| 10762 | ;; replace header prompts |
| 10763 | (vhdl-template-replace-header-keywords start end nil t) |
| 10764 | (goto-char start) |
| 10765 | ;; query other prompts |
| 10766 | (while (re-search-forward |
| 10767 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) |
| 10768 | (unless (equal "cursor" (match-string 1)) |
| 10769 | (setq position (match-beginning 1)) |
| 10770 | (setq prompt (match-string 1)) |
| 10771 | (replace-match "") |
| 10772 | (setq string (vhdl-template-field prompt nil t)) |
| 10773 | ;; replace occurrences of same prompt |
| 10774 | (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) |
| 10775 | (replace-match (or string ""))) |
| 10776 | (goto-char position))) |
| 10777 | (goto-char start) |
| 10778 | ;; goto final position |
| 10779 | (if (re-search-forward "<cursor>" end t) |
| 10780 | (replace-match "") |
| 10781 | (goto-char end)))))) |
| 10782 | |
| 10783 | (defun vhdl-model-defun () |
| 10784 | "Define help and hook functions for user models." |
| 10785 | (let ((model-alist vhdl-model-alist) |
| 10786 | model-name model-keyword) |
| 10787 | (while model-alist |
| 10788 | ;; define functions for user models that can be invoked from menu and key |
| 10789 | ;; bindings and which themselves call `vhdl-model-insert' with the model |
| 10790 | ;; name as argument |
| 10791 | (setq model-name (nth 0 (car model-alist))) |
| 10792 | (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () |
| 10793 | ,(concat "Insert model for \"" model-name "\".") |
| 10794 | (interactive) |
| 10795 | (vhdl-model-insert ,model-name))) |
| 10796 | ;; define hooks for user models that are invoked from keyword abbrevs |
| 10797 | (setq model-keyword (nth 3 (car model-alist))) |
| 10798 | (unless (equal model-keyword "") |
| 10799 | (eval `(defun |
| 10800 | ,(vhdl-function-name |
| 10801 | "vhdl-model" model-name "hook") () |
| 10802 | (vhdl-hooked-abbrev |
| 10803 | ',(vhdl-function-name "vhdl-model" model-name))))) |
| 10804 | (setq model-alist (cdr model-alist))))) |
| 10805 | |
| 10806 | (vhdl-model-defun) |
| 10807 | |
| 10808 | |
| 10809 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10810 | ;;; Port translation |
| 10811 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10812 | |
| 10813 | (defvar vhdl-port-list nil |
| 10814 | "Variable to hold last port map parsed.") |
| 10815 | ;; structure: (parenthesized expression means list of such entries) |
| 10816 | ;; (ent-name |
| 10817 | ;; ((generic-names) generic-type generic-init generic-comment group-comment) |
| 10818 | ;; ((port-names) port-object port-direct port-type port-comment group-comment) |
| 10819 | ;; (lib-name pack-key)) |
| 10820 | |
| 10821 | (defun vhdl-parse-string (string &optional optional) |
| 10822 | "Check that the text following point matches the regexp in STRING." |
| 10823 | (if (looking-at string) |
| 10824 | (goto-char (match-end 0)) |
| 10825 | (unless optional |
| 10826 | (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" |
| 10827 | (vhdl-current-line) string))) |
| 10828 | nil)) |
| 10829 | |
| 10830 | (defun vhdl-replace-string (regexp-cons string &optional adjust-case) |
| 10831 | "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." |
| 10832 | (vhdl-prepare-search-1 |
| 10833 | (if (string-match (car regexp-cons) string) |
| 10834 | (if adjust-case |
| 10835 | (funcall vhdl-file-name-case |
| 10836 | (replace-match (cdr regexp-cons) t nil string)) |
| 10837 | (replace-match (cdr regexp-cons) t nil string)) |
| 10838 | string))) |
| 10839 | |
| 10840 | (defun vhdl-parse-group-comment () |
| 10841 | "Parse comment and empty lines between groups of lines." |
| 10842 | (let ((start (point)) |
| 10843 | string) |
| 10844 | (vhdl-forward-comment (point-max)) |
| 10845 | (setq string (buffer-substring-no-properties start (point))) |
| 10846 | (vhdl-forward-syntactic-ws) |
| 10847 | ;; strip off leading blanks and first newline |
| 10848 | (while (string-match "^\\(\\s-+\\)" string) |
| 10849 | (setq string (concat (substring string 0 (match-beginning 1)) |
| 10850 | (substring string (match-end 1))))) |
| 10851 | (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) |
| 10852 | (substring string 1) |
| 10853 | string))) |
| 10854 | |
| 10855 | (defun vhdl-paste-group-comment (string indent) |
| 10856 | "Paste comment and empty lines from STRING between groups of lines |
| 10857 | with INDENT." |
| 10858 | (let ((pos (point-marker))) |
| 10859 | (when (> indent 0) |
| 10860 | (while (string-match "^\\(--\\)" string) |
| 10861 | (setq string (concat (substring string 0 (match-beginning 1)) |
| 10862 | (make-string indent ? ) |
| 10863 | (substring string (match-beginning 1)))))) |
| 10864 | (beginning-of-line) |
| 10865 | (insert string) |
| 10866 | (goto-char pos))) |
| 10867 | |
| 10868 | (defvar vhdl-port-flattened nil |
| 10869 | "Indicates whether a port has been flattened.") |
| 10870 | |
| 10871 | (defun vhdl-port-flatten (&optional as-alist) |
| 10872 | "Flatten port list so that only one generic/port exists per line. |
| 10873 | This operation is performed on an internally stored port and is only |
| 10874 | reflected in a subsequent paste operation." |
| 10875 | (interactive) |
| 10876 | (if (not vhdl-port-list) |
| 10877 | (error "ERROR: No port has been read") |
| 10878 | (message "Flattening port for next paste...") |
| 10879 | (let ((new-vhdl-port-list (list (car vhdl-port-list))) |
| 10880 | (old-vhdl-port-list (cdr vhdl-port-list)) |
| 10881 | old-port-list new-port-list old-port new-port names) |
| 10882 | ;; traverse port list and flatten entries |
| 10883 | (while (cdr old-vhdl-port-list) |
| 10884 | (setq old-port-list (car old-vhdl-port-list)) |
| 10885 | (setq new-port-list nil) |
| 10886 | (while old-port-list |
| 10887 | (setq old-port (car old-port-list)) |
| 10888 | (setq names (car old-port)) |
| 10889 | (while names |
| 10890 | (setq new-port (cons (if as-alist (car names) (list (car names))) |
| 10891 | (cdr old-port))) |
| 10892 | (setq new-port-list (append new-port-list (list new-port))) |
| 10893 | (setq names (cdr names))) |
| 10894 | (setq old-port-list (cdr old-port-list))) |
| 10895 | (setq old-vhdl-port-list (cdr old-vhdl-port-list)) |
| 10896 | (setq new-vhdl-port-list (append new-vhdl-port-list |
| 10897 | (list new-port-list)))) |
| 10898 | (setq vhdl-port-list |
| 10899 | (append new-vhdl-port-list (list old-vhdl-port-list)) |
| 10900 | vhdl-port-flattened t) |
| 10901 | (message "Flattening port for next paste...done")))) |
| 10902 | |
| 10903 | (defvar vhdl-port-reversed-direction nil |
| 10904 | "Indicates whether port directions are reversed.") |
| 10905 | |
| 10906 | (defun vhdl-port-reverse-direction () |
| 10907 | "Reverse direction for all ports (useful in testbenches). |
| 10908 | This operation is performed on an internally stored port and is only |
| 10909 | reflected in a subsequent paste operation." |
| 10910 | (interactive) |
| 10911 | (if (not vhdl-port-list) |
| 10912 | (error "ERROR: No port has been read") |
| 10913 | (message "Reversing port directions for next paste...") |
| 10914 | (let ((port-list (nth 2 vhdl-port-list)) |
| 10915 | port-dir-car port-dir) |
| 10916 | ;; traverse port list and reverse directions |
| 10917 | (while port-list |
| 10918 | (setq port-dir-car (cddr (car port-list)) |
| 10919 | port-dir (car port-dir-car)) |
| 10920 | (setcar port-dir-car |
| 10921 | (cond ((equal port-dir "in") "out") |
| 10922 | ((equal port-dir "out") "in") |
| 10923 | (t port-dir))) |
| 10924 | (setq port-list (cdr port-list))) |
| 10925 | (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) |
| 10926 | (message "Reversing port directions for next paste...done")))) |
| 10927 | |
| 10928 | (defun vhdl-port-copy () |
| 10929 | "Get generic and port information from an entity or component declaration." |
| 10930 | (interactive) |
| 10931 | (save-excursion |
| 10932 | (let (parse-error end-of-list |
| 10933 | decl-type name generic-list port-list context-clause |
| 10934 | object names direct type init comment group-comment) |
| 10935 | (vhdl-prepare-search-2 |
| 10936 | (setq |
| 10937 | parse-error |
| 10938 | (catch 'parse |
| 10939 | ;; check if within entity or component declaration |
| 10940 | (end-of-line) |
| 10941 | (when (or (not (re-search-backward |
| 10942 | "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) |
| 10943 | (equal "END" (upcase (match-string 1)))) |
| 10944 | (throw 'parse "ERROR: Not within an entity or component declaration")) |
| 10945 | (setq decl-type (downcase (match-string-no-properties 1))) |
| 10946 | (forward-word 1) |
| 10947 | (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") |
| 10948 | (setq name (match-string-no-properties 1)) |
| 10949 | (message "Reading port of %s \"%s\"..." decl-type name) |
| 10950 | (vhdl-forward-syntactic-ws) |
| 10951 | ;; parse generic clause |
| 10952 | (when (vhdl-parse-string "generic[ \t\n]*(" t) |
| 10953 | ;; parse group comment and spacing |
| 10954 | (setq group-comment (vhdl-parse-group-comment)) |
| 10955 | (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t)) |
| 10956 | (while (not end-of-list) |
| 10957 | ;; parse names (accept extended identifiers) |
| 10958 | (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") |
| 10959 | (setq names (list (match-string-no-properties 1))) |
| 10960 | (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t) |
| 10961 | (setq names |
| 10962 | (append names (list (match-string-no-properties 1))))) |
| 10963 | ;; parse type |
| 10964 | (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)") |
| 10965 | (setq type (match-string-no-properties 1)) |
| 10966 | (setq comment nil) |
| 10967 | (while (looking-at "(") |
| 10968 | (setq type |
| 10969 | (concat type |
| 10970 | (buffer-substring-no-properties |
| 10971 | (point) (progn (forward-sexp) (point))) |
| 10972 | (and (vhdl-parse-string "\\([^():;\n]*\\)" t) |
| 10973 | (match-string-no-properties 1))))) |
| 10974 | ;; special case: closing parenthesis is on separate line |
| 10975 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 10976 | (setq comment (substring type (match-beginning 2))) |
| 10977 | (setq type (substring type 0 (match-beginning 1)))) |
| 10978 | ;; strip of trailing group-comment |
| 10979 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 10980 | (setq type (substring type 0 (match-end 1))) |
| 10981 | ;; parse initialization expression |
| 10982 | (setq init nil) |
| 10983 | (when (vhdl-parse-string ":=[ \t\n]*" t) |
| 10984 | (vhdl-parse-string "\\([^();\n]*\\)") |
| 10985 | (setq init (match-string-no-properties 1)) |
| 10986 | (while (looking-at "(") |
| 10987 | (setq init |
| 10988 | (concat init |
| 10989 | (buffer-substring-no-properties |
| 10990 | (point) (progn (forward-sexp) (point))) |
| 10991 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 10992 | (match-string-no-properties 1)))))) |
| 10993 | ;; special case: closing parenthesis is on separate line |
| 10994 | (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) |
| 10995 | (setq comment (substring init (match-beginning 2))) |
| 10996 | (setq init (substring init 0 (match-beginning 1))) |
| 10997 | (vhdl-forward-syntactic-ws)) |
| 10998 | (skip-chars-forward " \t") |
| 10999 | ;; parse inline comment, special case: as above, no initial. |
| 11000 | (unless comment |
| 11001 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11002 | (match-string-no-properties 1)))) |
| 11003 | (vhdl-forward-syntactic-ws) |
| 11004 | (setq end-of-list (vhdl-parse-string ")" t)) |
| 11005 | (vhdl-parse-string "\\s-*;\\s-*") |
| 11006 | ;; parse inline comment |
| 11007 | (unless comment |
| 11008 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11009 | (match-string-no-properties 1)))) |
| 11010 | ;; save everything in list |
| 11011 | (setq generic-list (append generic-list |
| 11012 | (list (list names type init |
| 11013 | comment group-comment)))) |
| 11014 | ;; parse group comment and spacing |
| 11015 | (setq group-comment (vhdl-parse-group-comment)))) |
| 11016 | ;; parse port clause |
| 11017 | (when (vhdl-parse-string "port[ \t\n]*(" t) |
| 11018 | ;; parse group comment and spacing |
| 11019 | (setq group-comment (vhdl-parse-group-comment)) |
| 11020 | (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t)) |
| 11021 | (while (not end-of-list) |
| 11022 | ;; parse object |
| 11023 | (setq object |
| 11024 | (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n]*" t) |
| 11025 | (match-string-no-properties 1))) |
| 11026 | ;; parse names (accept extended identifiers) |
| 11027 | (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") |
| 11028 | (setq names (list (match-string-no-properties 1))) |
| 11029 | (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t) |
| 11030 | (setq names (append names (list (match-string-no-properties 1))))) |
| 11031 | ;; parse direction |
| 11032 | (vhdl-parse-string ":[ \t\n]*") |
| 11033 | (setq direct |
| 11034 | (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n]+" t) |
| 11035 | (match-string-no-properties 1))) |
| 11036 | ;; parse type |
| 11037 | (vhdl-parse-string "\\([^();\n]+\\)") |
| 11038 | (setq type (match-string-no-properties 1)) |
| 11039 | (setq comment nil) |
| 11040 | (while (looking-at "(") |
| 11041 | (setq type (concat type |
| 11042 | (buffer-substring-no-properties |
| 11043 | (point) (progn (forward-sexp) (point))) |
| 11044 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 11045 | (match-string-no-properties 1))))) |
| 11046 | ;; special case: closing parenthesis is on separate line |
| 11047 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 11048 | (setq comment (substring type (match-beginning 2))) |
| 11049 | (setq type (substring type 0 (match-beginning 1)))) |
| 11050 | ;; strip of trailing group-comment |
| 11051 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 11052 | (setq type (substring type 0 (match-end 1))) |
| 11053 | (vhdl-forward-syntactic-ws) |
| 11054 | (setq end-of-list (vhdl-parse-string ")" t)) |
| 11055 | (vhdl-parse-string "\\s-*;\\s-*") |
| 11056 | ;; parse inline comment |
| 11057 | (unless comment |
| 11058 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11059 | (match-string-no-properties 1)))) |
| 11060 | ;; save everything in list |
| 11061 | (setq port-list (append port-list |
| 11062 | (list (list names object direct type |
| 11063 | comment group-comment)))) |
| 11064 | ;; parse group comment and spacing |
| 11065 | (setq group-comment (vhdl-parse-group-comment)))) |
| 11066 | ; (vhdl-parse-string "end\\>") |
| 11067 | ;; parse context clause |
| 11068 | (setq context-clause (vhdl-scan-context-clause)) |
| 11069 | ; ;; add surrounding package to context clause |
| 11070 | ; (when (and (equal decl-type "component") |
| 11071 | ; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) |
| 11072 | ; (setq context-clause |
| 11073 | ; (append context-clause |
| 11074 | ; (list (cons (vhdl-work-library) |
| 11075 | ; (match-string-no-properties 1)))))) |
| 11076 | (message "Reading port of %s \"%s\"...done" decl-type name) |
| 11077 | nil))) |
| 11078 | ;; finish parsing |
| 11079 | (if parse-error |
| 11080 | (error parse-error) |
| 11081 | (setq vhdl-port-list (list name generic-list port-list context-clause) |
| 11082 | vhdl-port-reversed-direction nil |
| 11083 | vhdl-port-flattened nil))))) |
| 11084 | |
| 11085 | (defun vhdl-port-paste-context-clause (&optional exclude-pack-name) |
| 11086 | "Paste a context clause." |
| 11087 | (let ((margin (current-indentation)) |
| 11088 | (clause-list (nth 3 vhdl-port-list)) |
| 11089 | clause) |
| 11090 | (while clause-list |
| 11091 | (setq clause (car clause-list)) |
| 11092 | (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) |
| 11093 | (downcase exclude-pack-name))) |
| 11094 | (save-excursion |
| 11095 | (re-search-backward |
| 11096 | (concat "^\\s-*use\\s-+" (car clause) |
| 11097 | "\." (cdr clause) "\\>") nil t))) |
| 11098 | (vhdl-template-standard-package (car clause) (cdr clause)) |
| 11099 | (insert "\n")) |
| 11100 | (setq clause-list (cdr clause-list))))) |
| 11101 | |
| 11102 | (defun vhdl-port-paste-generic (&optional no-init) |
| 11103 | "Paste a generic clause." |
| 11104 | (let ((margin (current-indentation)) |
| 11105 | (generic-list (nth 1 vhdl-port-list)) |
| 11106 | list-margin start names generic) |
| 11107 | ;; paste generic clause |
| 11108 | (when generic-list |
| 11109 | (setq start (point)) |
| 11110 | (vhdl-insert-keyword "GENERIC (") |
| 11111 | (unless vhdl-argument-list-indent |
| 11112 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11113 | (setq list-margin (current-column)) |
| 11114 | (while generic-list |
| 11115 | (setq generic (car generic-list)) |
| 11116 | ;; paste group comment and spacing |
| 11117 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11118 | (vhdl-paste-group-comment (nth 4 generic) list-margin)) |
| 11119 | ;; paste names |
| 11120 | (setq names (nth 0 generic)) |
| 11121 | (while names |
| 11122 | (insert (car names)) |
| 11123 | (setq names (cdr names)) |
| 11124 | (when names (insert ", "))) |
| 11125 | ;; paste type |
| 11126 | (insert " : " (nth 1 generic)) |
| 11127 | ;; paste initialization |
| 11128 | (when (and (not no-init) (nth 2 generic)) |
| 11129 | (insert " := " (nth 2 generic))) |
| 11130 | (unless (cdr generic-list) (insert ")")) |
| 11131 | (insert ";") |
| 11132 | ;; paste comment |
| 11133 | (when (and vhdl-include-port-comments (nth 3 generic)) |
| 11134 | (vhdl-comment-insert-inline (nth 3 generic) t)) |
| 11135 | (setq generic-list (cdr generic-list)) |
| 11136 | (when generic-list (insert "\n") (indent-to list-margin))) |
| 11137 | ;; align generic clause |
| 11138 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) |
| 11139 | |
| 11140 | (defun vhdl-port-paste-port () |
| 11141 | "Paste a port clause." |
| 11142 | (let ((margin (current-indentation)) |
| 11143 | (port-list (nth 2 vhdl-port-list)) |
| 11144 | list-margin start names port) |
| 11145 | ;; paste port clause |
| 11146 | (when port-list |
| 11147 | (setq start (point)) |
| 11148 | (vhdl-insert-keyword "PORT (") |
| 11149 | (unless vhdl-argument-list-indent |
| 11150 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11151 | (setq list-margin (current-column)) |
| 11152 | (while port-list |
| 11153 | (setq port (car port-list)) |
| 11154 | ;; paste group comment and spacing |
| 11155 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11156 | (vhdl-paste-group-comment (nth 5 port) list-margin)) |
| 11157 | ;; paste object |
| 11158 | (when (nth 1 port) (insert (nth 1 port) " ")) |
| 11159 | ;; paste names |
| 11160 | (setq names (nth 0 port)) |
| 11161 | (while names |
| 11162 | (insert (car names)) |
| 11163 | (setq names (cdr names)) |
| 11164 | (when names (insert ", "))) |
| 11165 | ;; paste direction |
| 11166 | (insert " : ") |
| 11167 | (when (nth 2 port) (insert (nth 2 port) " ")) |
| 11168 | ;; paste type |
| 11169 | (insert (nth 3 port)) |
| 11170 | (unless (cdr port-list) (insert ")")) |
| 11171 | (insert ";") |
| 11172 | ;; paste comment |
| 11173 | (when (and vhdl-include-port-comments (nth 4 port)) |
| 11174 | (vhdl-comment-insert-inline (nth 4 port) t)) |
| 11175 | (setq port-list (cdr port-list)) |
| 11176 | (when port-list (insert "\n") (indent-to list-margin))) |
| 11177 | ;; align port clause |
| 11178 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 11179 | |
| 11180 | (defun vhdl-port-paste-declaration (kind &optional no-indent) |
| 11181 | "Paste as an entity or component declaration." |
| 11182 | (unless no-indent (indent-according-to-mode)) |
| 11183 | (let ((margin (current-indentation)) |
| 11184 | (name (nth 0 vhdl-port-list))) |
| 11185 | (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) |
| 11186 | (insert name) |
| 11187 | (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) |
| 11188 | (vhdl-insert-keyword " IS")) |
| 11189 | ;; paste generic and port clause |
| 11190 | (when (nth 1 vhdl-port-list) |
| 11191 | (insert "\n") |
| 11192 | (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) |
| 11193 | (insert "\n")) |
| 11194 | (indent-to (+ margin vhdl-basic-offset)) |
| 11195 | (vhdl-port-paste-generic (eq kind 'component))) |
| 11196 | (when (nth 2 vhdl-port-list) |
| 11197 | (insert "\n") |
| 11198 | (when (and (memq vhdl-insert-empty-lines '(unit all)) |
| 11199 | (eq kind 'entity)) |
| 11200 | (insert "\n")) |
| 11201 | (indent-to (+ margin vhdl-basic-offset))) |
| 11202 | (vhdl-port-paste-port) |
| 11203 | (insert "\n") |
| 11204 | (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) |
| 11205 | (insert "\n")) |
| 11206 | (indent-to margin) |
| 11207 | (vhdl-insert-keyword "END") |
| 11208 | (if (eq kind 'entity) |
| 11209 | (progn |
| 11210 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) |
| 11211 | (insert " " name)) |
| 11212 | (vhdl-insert-keyword " COMPONENT") |
| 11213 | (unless (vhdl-standard-p '87) (insert " " name))) |
| 11214 | (insert ";"))) |
| 11215 | |
| 11216 | (defun vhdl-port-paste-entity (&optional no-indent) |
| 11217 | "Paste as an entity declaration." |
| 11218 | (interactive) |
| 11219 | (if (not vhdl-port-list) |
| 11220 | (error "ERROR: No port read") |
| 11221 | (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) |
| 11222 | (vhdl-port-paste-declaration 'entity no-indent) |
| 11223 | (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) |
| 11224 | |
| 11225 | (defun vhdl-port-paste-component (&optional no-indent) |
| 11226 | "Paste as a component declaration." |
| 11227 | (interactive) |
| 11228 | (if (not vhdl-port-list) |
| 11229 | (error "ERROR: No port read") |
| 11230 | (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) |
| 11231 | (vhdl-port-paste-declaration 'component no-indent) |
| 11232 | (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) |
| 11233 | |
| 11234 | (defun vhdl-port-paste-generic-map (&optional secondary no-constants) |
| 11235 | "Paste as a generic map." |
| 11236 | (interactive) |
| 11237 | (unless secondary (indent-according-to-mode)) |
| 11238 | (let ((margin (current-indentation)) |
| 11239 | list-margin start generic |
| 11240 | (generic-list (nth 1 vhdl-port-list))) |
| 11241 | (when generic-list |
| 11242 | (setq start (point)) |
| 11243 | (vhdl-insert-keyword "GENERIC MAP (") |
| 11244 | (if (not vhdl-association-list-with-formals) |
| 11245 | ;; paste list of actual generics |
| 11246 | (while generic-list |
| 11247 | (insert (if no-constants |
| 11248 | (car (nth 0 (car generic-list))) |
| 11249 | (or (nth 2 (car generic-list)) " "))) |
| 11250 | (setq generic-list (cdr generic-list)) |
| 11251 | (insert (if generic-list ", " ")")) |
| 11252 | (when (and (not generic-list) secondary |
| 11253 | (null (nth 2 vhdl-port-list))) |
| 11254 | (insert ";"))) |
| 11255 | (unless vhdl-argument-list-indent |
| 11256 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11257 | (setq list-margin (current-column)) |
| 11258 | (while generic-list |
| 11259 | (setq generic (car generic-list)) |
| 11260 | ;; paste group comment and spacing |
| 11261 | (when (eq vhdl-include-group-comments 'always) |
| 11262 | (vhdl-paste-group-comment (nth 4 generic) list-margin)) |
| 11263 | ;; paste formal and actual generic |
| 11264 | (insert (car (nth 0 generic)) " => " |
| 11265 | (if no-constants |
| 11266 | (car (nth 0 generic)) |
| 11267 | (or (nth 2 generic) ""))) |
| 11268 | (setq generic-list (cdr generic-list)) |
| 11269 | (insert (if generic-list "," ")")) |
| 11270 | (when (and (not generic-list) secondary |
| 11271 | (null (nth 2 vhdl-port-list))) |
| 11272 | (insert ";")) |
| 11273 | ;; paste comment |
| 11274 | (when (or vhdl-include-type-comments |
| 11275 | (and vhdl-include-port-comments (nth 3 generic))) |
| 11276 | (vhdl-comment-insert-inline |
| 11277 | (concat |
| 11278 | (when vhdl-include-type-comments |
| 11279 | (concat "[" (nth 1 generic) "] ")) |
| 11280 | (when vhdl-include-port-comments (nth 3 generic))) t)) |
| 11281 | (when generic-list (insert "\n") (indent-to list-margin))) |
| 11282 | ;; align generic map |
| 11283 | (when vhdl-auto-align |
| 11284 | (vhdl-align-region-groups start (point) 1 t)))))) |
| 11285 | |
| 11286 | (defun vhdl-port-paste-port-map () |
| 11287 | "Paste as a port map." |
| 11288 | (let ((margin (current-indentation)) |
| 11289 | list-margin start port |
| 11290 | (port-list (nth 2 vhdl-port-list))) |
| 11291 | (when port-list |
| 11292 | (setq start (point)) |
| 11293 | (vhdl-insert-keyword "PORT MAP (") |
| 11294 | (if (not vhdl-association-list-with-formals) |
| 11295 | ;; paste list of actual ports |
| 11296 | (while port-list |
| 11297 | (insert (vhdl-replace-string vhdl-actual-port-name |
| 11298 | (car (nth 0 (car port-list))))) |
| 11299 | (setq port-list (cdr port-list)) |
| 11300 | (insert (if port-list ", " ")"))) |
| 11301 | (unless vhdl-argument-list-indent |
| 11302 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11303 | (setq list-margin (current-column)) |
| 11304 | (while port-list |
| 11305 | (setq port (car port-list)) |
| 11306 | ;; paste group comment and spacing |
| 11307 | (when (eq vhdl-include-group-comments 'always) |
| 11308 | (vhdl-paste-group-comment (nth 5 port) list-margin)) |
| 11309 | ;; paste formal and actual port |
| 11310 | (insert (car (nth 0 port)) " => ") |
| 11311 | (insert (vhdl-replace-string vhdl-actual-port-name |
| 11312 | (car (nth 0 port)))) |
| 11313 | (setq port-list (cdr port-list)) |
| 11314 | (insert (if port-list "," ");")) |
| 11315 | ;; paste comment |
| 11316 | (when (or vhdl-include-direction-comments |
| 11317 | vhdl-include-type-comments |
| 11318 | (and vhdl-include-port-comments (nth 4 port))) |
| 11319 | (vhdl-comment-insert-inline |
| 11320 | (concat |
| 11321 | (cond ((and vhdl-include-direction-comments |
| 11322 | vhdl-include-type-comments) |
| 11323 | (concat "[" (format "%-4s" (concat (nth 2 port) " ")) |
| 11324 | (nth 3 port) "] ")) |
| 11325 | ((and vhdl-include-direction-comments (nth 2 port)) |
| 11326 | (format "%-6s" (concat "[" (nth 2 port) "] "))) |
| 11327 | (vhdl-include-direction-comments " ") |
| 11328 | (vhdl-include-type-comments |
| 11329 | (concat "[" (nth 3 port) "] "))) |
| 11330 | (when vhdl-include-port-comments (nth 4 port))) t)) |
| 11331 | (when port-list (insert "\n") (indent-to list-margin))) |
| 11332 | ;; align port clause |
| 11333 | (when vhdl-auto-align |
| 11334 | (vhdl-align-region-groups start (point) 1)))))) |
| 11335 | |
| 11336 | (defun vhdl-port-paste-instance (&optional name no-indent title) |
| 11337 | "Paste as an instantiation." |
| 11338 | (interactive) |
| 11339 | (if (not vhdl-port-list) |
| 11340 | (error "ERROR: No port read") |
| 11341 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 11342 | ;; flatten local copy of port list (must be flat for port mapping) |
| 11343 | (vhdl-port-flatten) |
| 11344 | (unless no-indent (indent-according-to-mode)) |
| 11345 | (let ((margin (current-indentation))) |
| 11346 | ;; paste instantiation |
| 11347 | (cond (name |
| 11348 | (insert name)) |
| 11349 | ((equal (cdr vhdl-instance-name) "") |
| 11350 | (setq name (vhdl-template-field "instance name"))) |
| 11351 | ((string-match "\%d" (cdr vhdl-instance-name)) |
| 11352 | (let ((n 1)) |
| 11353 | (while (save-excursion |
| 11354 | (setq name (format (vhdl-replace-string |
| 11355 | vhdl-instance-name |
| 11356 | (nth 0 vhdl-port-list)) n)) |
| 11357 | (goto-char (point-min)) |
| 11358 | (vhdl-re-search-forward name nil t)) |
| 11359 | (setq n (1+ n))) |
| 11360 | (insert name))) |
| 11361 | (t (insert (vhdl-replace-string vhdl-instance-name |
| 11362 | (nth 0 vhdl-port-list))))) |
| 11363 | (message "Pasting port as instantiation \"%s\"..." name) |
| 11364 | (insert ": ") |
| 11365 | (when title |
| 11366 | (save-excursion |
| 11367 | (beginning-of-line) |
| 11368 | (indent-to vhdl-basic-offset) |
| 11369 | (insert "-- instance \"" name "\"\n"))) |
| 11370 | (if (not (vhdl-use-direct-instantiation)) |
| 11371 | (insert (nth 0 vhdl-port-list)) |
| 11372 | (vhdl-insert-keyword "ENTITY ") |
| 11373 | (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) |
| 11374 | (when (nth 1 vhdl-port-list) |
| 11375 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 11376 | (vhdl-port-paste-generic-map t t)) |
| 11377 | (when (nth 2 vhdl-port-list) |
| 11378 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 11379 | (vhdl-port-paste-port-map)) |
| 11380 | (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) |
| 11381 | (insert ";")) |
| 11382 | (message "Pasting port as instantiation \"%s\"...done" name)) |
| 11383 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 11384 | |
| 11385 | (defun vhdl-port-paste-constants (&optional no-indent) |
| 11386 | "Paste generics as constants." |
| 11387 | (interactive) |
| 11388 | (if (not vhdl-port-list) |
| 11389 | (error "ERROR: No port read") |
| 11390 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 11391 | (message "Pasting port as constants...") |
| 11392 | ;; flatten local copy of port list (must be flat for constant initial.) |
| 11393 | (vhdl-port-flatten) |
| 11394 | (unless no-indent (indent-according-to-mode)) |
| 11395 | (let ((margin (current-indentation)) |
| 11396 | start generic name |
| 11397 | (generic-list (nth 1 vhdl-port-list))) |
| 11398 | (when generic-list |
| 11399 | (setq start (point)) |
| 11400 | (while generic-list |
| 11401 | (setq generic (car generic-list)) |
| 11402 | ;; paste group comment and spacing |
| 11403 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11404 | (vhdl-paste-group-comment (nth 4 generic) margin)) |
| 11405 | (vhdl-insert-keyword "CONSTANT ") |
| 11406 | ;; paste generic constants |
| 11407 | (setq name (nth 0 generic)) |
| 11408 | (when name |
| 11409 | (insert (car name)) |
| 11410 | ;; paste type |
| 11411 | (insert " : " (nth 1 generic)) |
| 11412 | ;; paste initialization |
| 11413 | (when (nth 2 generic) |
| 11414 | (insert " := " (nth 2 generic))) |
| 11415 | (insert ";") |
| 11416 | ;; paste comment |
| 11417 | (when (and vhdl-include-port-comments (nth 3 generic)) |
| 11418 | (vhdl-comment-insert-inline (nth 3 generic) t)) |
| 11419 | (setq generic-list (cdr generic-list)) |
| 11420 | (when generic-list (insert "\n") (indent-to margin)))) |
| 11421 | ;; align signal list |
| 11422 | (when vhdl-auto-align |
| 11423 | (vhdl-align-region-groups start (point) 1)))) |
| 11424 | (message "Pasting port as constants...done") |
| 11425 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 11426 | |
| 11427 | (defun vhdl-port-paste-signals (&optional initialize no-indent) |
| 11428 | "Paste ports as internal signals." |
| 11429 | (interactive) |
| 11430 | (if (not vhdl-port-list) |
| 11431 | (error "ERROR: No port read") |
| 11432 | (message "Pasting port as signals...") |
| 11433 | (unless no-indent (indent-according-to-mode)) |
| 11434 | (let ((margin (current-indentation)) |
| 11435 | start port names |
| 11436 | (port-list (nth 2 vhdl-port-list))) |
| 11437 | (when port-list |
| 11438 | (setq start (point)) |
| 11439 | (while port-list |
| 11440 | (setq port (car port-list)) |
| 11441 | ;; paste group comment and spacing |
| 11442 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11443 | (vhdl-paste-group-comment (nth 5 port) margin)) |
| 11444 | ;; paste object |
| 11445 | (if (nth 1 port) |
| 11446 | (insert (nth 1 port) " ") |
| 11447 | (vhdl-insert-keyword "SIGNAL ")) |
| 11448 | ;; paste actual port signals |
| 11449 | (setq names (nth 0 port)) |
| 11450 | (while names |
| 11451 | (insert (vhdl-replace-string vhdl-actual-port-name (car names))) |
| 11452 | (setq names (cdr names)) |
| 11453 | (when names (insert ", "))) |
| 11454 | ;; paste type |
| 11455 | (insert " : " (nth 3 port)) |
| 11456 | ;; paste initialization (inputs only) |
| 11457 | (when (and initialize (equal "IN" (upcase (nth 2 port)))) |
| 11458 | (insert " := " (if (string-match "(.+)" (nth 3 port)) |
| 11459 | "(others => '0')" "'0'"))) |
| 11460 | (insert ";") |
| 11461 | ;; paste comment |
| 11462 | (when (or vhdl-include-direction-comments |
| 11463 | (and vhdl-include-port-comments (nth 4 port))) |
| 11464 | (vhdl-comment-insert-inline |
| 11465 | (concat |
| 11466 | (cond ((and vhdl-include-direction-comments (nth 2 port)) |
| 11467 | (format "%-6s" (concat "[" (nth 2 port) "] "))) |
| 11468 | (vhdl-include-direction-comments " ")) |
| 11469 | (when vhdl-include-port-comments (nth 4 port))) t)) |
| 11470 | (setq port-list (cdr port-list)) |
| 11471 | (when port-list (insert "\n") (indent-to margin))) |
| 11472 | ;; align signal list |
| 11473 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) |
| 11474 | (message "Pasting port as signals...done"))) |
| 11475 | |
| 11476 | (defun vhdl-port-paste-initializations (&optional no-indent) |
| 11477 | "Paste ports as signal initializations." |
| 11478 | (interactive) |
| 11479 | (if (not vhdl-port-list) |
| 11480 | (error "ERROR: No port read") |
| 11481 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 11482 | (message "Pasting port as initializations...") |
| 11483 | ;; flatten local copy of port list (must be flat for signal initial.) |
| 11484 | (vhdl-port-flatten) |
| 11485 | (unless no-indent (indent-according-to-mode)) |
| 11486 | (let ((margin (current-indentation)) |
| 11487 | start port name |
| 11488 | (port-list (nth 2 vhdl-port-list))) |
| 11489 | (when port-list |
| 11490 | (setq start (point)) |
| 11491 | (while port-list |
| 11492 | (setq port (car port-list)) |
| 11493 | ;; paste actual port signal (inputs only) |
| 11494 | (when (equal "IN" (upcase (nth 2 port))) |
| 11495 | (setq name (car (nth 0 port))) |
| 11496 | (insert (vhdl-replace-string vhdl-actual-port-name name)) |
| 11497 | ;; paste initialization |
| 11498 | (insert " <= " (if (string-match "(.+)" (nth 3 port)) |
| 11499 | "(others => '0')" "'0'") ";")) |
| 11500 | (setq port-list (cdr port-list)) |
| 11501 | (when (and port-list |
| 11502 | (equal "IN" (upcase (nth 2 (car port-list))))) |
| 11503 | (insert "\n") (indent-to margin))) |
| 11504 | ;; align signal list |
| 11505 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) |
| 11506 | (message "Pasting port as initializations...done") |
| 11507 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 11508 | |
| 11509 | (defun vhdl-port-paste-testbench () |
| 11510 | "Paste as a bare-bones testbench." |
| 11511 | (interactive) |
| 11512 | (if (not vhdl-port-list) |
| 11513 | (error "ERROR: No port read") |
| 11514 | (let ((case-fold-search t) |
| 11515 | (ent-name (vhdl-replace-string vhdl-testbench-entity-name |
| 11516 | (nth 0 vhdl-port-list))) |
| 11517 | (source-buffer (current-buffer)) |
| 11518 | arch-name config-name ent-file-name arch-file-name |
| 11519 | ent-buffer arch-buffer position) |
| 11520 | ;; open entity file |
| 11521 | (unless (eq vhdl-testbench-create-files 'none) |
| 11522 | (setq ent-file-name |
| 11523 | (concat (vhdl-replace-string vhdl-testbench-entity-file-name |
| 11524 | ent-name t) |
| 11525 | "." (file-name-extension (buffer-file-name)))) |
| 11526 | (if (file-exists-p ent-file-name) |
| 11527 | (if (y-or-n-p |
| 11528 | (concat "File \"" ent-file-name "\" exists; overwrite? ")) |
| 11529 | (progn (find-file ent-file-name) |
| 11530 | (erase-buffer) |
| 11531 | (set-buffer-modified-p nil)) |
| 11532 | (if (eq vhdl-testbench-create-files 'separate) |
| 11533 | (setq ent-file-name nil) |
| 11534 | (error "ERROR: Pasting port as testbench...aborted"))) |
| 11535 | (find-file ent-file-name))) |
| 11536 | (unless (and (eq vhdl-testbench-create-files 'separate) |
| 11537 | (null ent-file-name)) |
| 11538 | ;; paste entity header |
| 11539 | (if vhdl-testbench-include-header |
| 11540 | (progn (vhdl-template-header |
| 11541 | (concat "Testbench for design \"" |
| 11542 | (nth 0 vhdl-port-list) "\"")) |
| 11543 | (goto-char (point-max))) |
| 11544 | (vhdl-comment-display-line) (insert "\n\n")) |
| 11545 | ;; paste std_logic_1164 package |
| 11546 | (when vhdl-testbench-include-library |
| 11547 | (vhdl-template-package-std-logic-1164) |
| 11548 | (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) |
| 11549 | ;; paste entity declaration |
| 11550 | (vhdl-insert-keyword "ENTITY ") |
| 11551 | (insert ent-name) |
| 11552 | (vhdl-insert-keyword " IS") |
| 11553 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 11554 | (insert "\n") |
| 11555 | (vhdl-insert-keyword "END ") |
| 11556 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 11557 | (insert ent-name ";") |
| 11558 | (insert "\n\n") |
| 11559 | (vhdl-comment-display-line) (insert "\n")) |
| 11560 | ;; get architecture name |
| 11561 | (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") |
| 11562 | (read-from-minibuffer "architecture name: " |
| 11563 | nil vhdl-minibuffer-local-map) |
| 11564 | (vhdl-replace-string vhdl-testbench-architecture-name |
| 11565 | (nth 0 vhdl-port-list)))) |
| 11566 | (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) |
| 11567 | ;; open architecture file |
| 11568 | (if (not (eq vhdl-testbench-create-files 'separate)) |
| 11569 | (insert "\n") |
| 11570 | (setq ent-buffer (current-buffer)) |
| 11571 | (setq arch-file-name |
| 11572 | (concat (vhdl-replace-string vhdl-testbench-architecture-file-name |
| 11573 | (concat ent-name " " arch-name) t) |
| 11574 | "." (file-name-extension (buffer-file-name)))) |
| 11575 | (when (and (file-exists-p arch-file-name) |
| 11576 | (not (y-or-n-p (concat "File \"" arch-file-name |
| 11577 | "\" exists; overwrite? ")))) |
| 11578 | (error "ERROR: Pasting port as testbench...aborted")) |
| 11579 | (find-file arch-file-name) |
| 11580 | (erase-buffer) |
| 11581 | (set-buffer-modified-p nil) |
| 11582 | ;; paste architecture header |
| 11583 | (if vhdl-testbench-include-header |
| 11584 | (progn (vhdl-template-header |
| 11585 | (concat "Testbench architecture for design \"" |
| 11586 | (nth 0 vhdl-port-list) "\"")) |
| 11587 | (goto-char (point-max))) |
| 11588 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 11589 | ;; paste architecture body |
| 11590 | (vhdl-insert-keyword "ARCHITECTURE ") |
| 11591 | (insert arch-name) |
| 11592 | (vhdl-insert-keyword " OF ") |
| 11593 | (insert ent-name) |
| 11594 | (vhdl-insert-keyword " IS") |
| 11595 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 11596 | ;; paste component declaration |
| 11597 | (unless (vhdl-use-direct-instantiation) |
| 11598 | (vhdl-port-paste-component t) |
| 11599 | (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 11600 | ;; paste constants |
| 11601 | (when (nth 1 vhdl-port-list) |
| 11602 | (insert "-- component generics\n") (indent-to vhdl-basic-offset) |
| 11603 | (vhdl-port-paste-constants t) |
| 11604 | (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 11605 | ;; paste internal signals |
| 11606 | (insert "-- component ports\n") (indent-to vhdl-basic-offset) |
| 11607 | (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) |
| 11608 | (insert "\n") |
| 11609 | ;; paste custom declarations |
| 11610 | (unless (equal "" vhdl-testbench-declarations) |
| 11611 | (insert "\n") |
| 11612 | (vhdl-insert-string-or-file vhdl-testbench-declarations)) |
| 11613 | (setq position (point)) |
| 11614 | (insert "\n\n") |
| 11615 | (vhdl-comment-display-line) (insert "\n") |
| 11616 | (when vhdl-testbench-include-configuration |
| 11617 | (setq config-name (vhdl-replace-string |
| 11618 | vhdl-testbench-configuration-name |
| 11619 | (concat ent-name " " arch-name))) |
| 11620 | (insert "\n") |
| 11621 | (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) |
| 11622 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 11623 | (vhdl-insert-keyword " IS\n") |
| 11624 | (indent-to vhdl-basic-offset) |
| 11625 | (vhdl-insert-keyword "FOR ") (insert arch-name "\n") |
| 11626 | (indent-to vhdl-basic-offset) |
| 11627 | (vhdl-insert-keyword "END FOR;\n") |
| 11628 | (vhdl-insert-keyword "END ") (insert config-name ";\n\n") |
| 11629 | (vhdl-comment-display-line) (insert "\n")) |
| 11630 | (goto-char position) |
| 11631 | (vhdl-template-begin-end |
| 11632 | (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) |
| 11633 | ;; paste instantiation |
| 11634 | (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) |
| 11635 | (vhdl-port-paste-instance |
| 11636 | (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) |
| 11637 | (insert "\n") |
| 11638 | ;; paste custom statements |
| 11639 | (unless (equal "" vhdl-testbench-statements) |
| 11640 | (insert "\n") |
| 11641 | (vhdl-insert-string-or-file vhdl-testbench-statements)) |
| 11642 | (insert "\n") |
| 11643 | (indent-to vhdl-basic-offset) |
| 11644 | (unless (eq vhdl-testbench-create-files 'none) |
| 11645 | (setq arch-buffer (current-buffer)) |
| 11646 | (when ent-buffer (set-buffer ent-buffer) (save-buffer)) |
| 11647 | (set-buffer arch-buffer) (save-buffer)) |
| 11648 | (message "%s" |
| 11649 | (concat (format "Pasting port as testbench \"%s(%s)\"...done" |
| 11650 | ent-name arch-name) |
| 11651 | (and ent-file-name |
| 11652 | (format "\n File created: \"%s\"" ent-file-name)) |
| 11653 | (and arch-file-name |
| 11654 | (format "\n File created: \"%s\"" arch-file-name))))))) |
| 11655 | |
| 11656 | |
| 11657 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11658 | ;;; Subprogram interface translation |
| 11659 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11660 | |
| 11661 | (defvar vhdl-subprog-list nil |
| 11662 | "Variable to hold last subprogram interface parsed.") |
| 11663 | ;; structure: (parenthesized expression means list of such entries) |
| 11664 | ;; (subprog-name kind |
| 11665 | ;; ((names) object direct type init comment group-comment) |
| 11666 | ;; return-type return-comment group-comment) |
| 11667 | |
| 11668 | (defvar vhdl-subprog-flattened nil |
| 11669 | "Indicates whether an subprogram interface has been flattened.") |
| 11670 | |
| 11671 | (defun vhdl-subprog-flatten () |
| 11672 | "Flatten interface list so that only one parameter exists per line." |
| 11673 | (interactive) |
| 11674 | (if (not vhdl-subprog-list) |
| 11675 | (error "ERROR: No subprogram interface has been read") |
| 11676 | (message "Flattening subprogram interface...") |
| 11677 | (let ((old-subprog-list (nth 2 vhdl-subprog-list)) |
| 11678 | new-subprog-list old-subprog new-subprog names) |
| 11679 | ;; traverse parameter list and flatten entries |
| 11680 | (while old-subprog-list |
| 11681 | (setq old-subprog (car old-subprog-list)) |
| 11682 | (setq names (car old-subprog)) |
| 11683 | (while names |
| 11684 | (setq new-subprog (cons (list (car names)) (cdr old-subprog))) |
| 11685 | (setq new-subprog-list (append new-subprog-list (list new-subprog))) |
| 11686 | (setq names (cdr names))) |
| 11687 | (setq old-subprog-list (cdr old-subprog-list))) |
| 11688 | (setq vhdl-subprog-list |
| 11689 | (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) |
| 11690 | new-subprog-list (nth 3 vhdl-subprog-list) |
| 11691 | (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) |
| 11692 | vhdl-subprog-flattened t) |
| 11693 | (message "Flattening subprogram interface...done")))) |
| 11694 | |
| 11695 | (defun vhdl-subprog-copy () |
| 11696 | "Get interface information from a subprogram specification." |
| 11697 | (interactive) |
| 11698 | (save-excursion |
| 11699 | (let (parse-error pos end-of-list |
| 11700 | name kind param-list object names direct type init |
| 11701 | comment group-comment |
| 11702 | return-type return-comment return-group-comment) |
| 11703 | (vhdl-prepare-search-2 |
| 11704 | (setq |
| 11705 | parse-error |
| 11706 | (catch 'parse |
| 11707 | ;; check if within function declaration |
| 11708 | (setq pos (point)) |
| 11709 | (end-of-line) |
| 11710 | (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) |
| 11711 | (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) |
| 11712 | (goto-char (match-end 0)) |
| 11713 | (save-excursion (backward-char) |
| 11714 | (forward-sexp) |
| 11715 | (<= pos (point)))) |
| 11716 | (throw 'parse "ERROR: Not within a subprogram specification")) |
| 11717 | (setq name (match-string-no-properties 5)) |
| 11718 | (setq kind (if (match-string 2) 'procedure 'function)) |
| 11719 | (setq end-of-list (not (match-string 7))) |
| 11720 | (message "Reading interface of subprogram \"%s\"..." name) |
| 11721 | ;; parse parameter list |
| 11722 | (setq group-comment (vhdl-parse-group-comment)) |
| 11723 | (setq end-of-list (or end-of-list |
| 11724 | (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) |
| 11725 | (while (not end-of-list) |
| 11726 | ;; parse object |
| 11727 | (setq object |
| 11728 | (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t) |
| 11729 | (match-string-no-properties 1))) |
| 11730 | ;; parse names (accept extended identifiers) |
| 11731 | (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") |
| 11732 | (setq names (list (match-string-no-properties 1))) |
| 11733 | (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t) |
| 11734 | (setq names (append names (list (match-string-no-properties 1))))) |
| 11735 | ;; parse direction |
| 11736 | (vhdl-parse-string ":[ \t\n]*") |
| 11737 | (setq direct |
| 11738 | (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t) |
| 11739 | (match-string-no-properties 1))) |
| 11740 | ;; parse type |
| 11741 | (vhdl-parse-string "\\([^():;\n]+\\)") |
| 11742 | (setq type (match-string-no-properties 1)) |
| 11743 | (setq comment nil) |
| 11744 | (while (looking-at "(") |
| 11745 | (setq type |
| 11746 | (concat type |
| 11747 | (buffer-substring-no-properties |
| 11748 | (point) (progn (forward-sexp) (point))) |
| 11749 | (and (vhdl-parse-string "\\([^():;\n]*\\)" t) |
| 11750 | (match-string-no-properties 1))))) |
| 11751 | ;; special case: closing parenthesis is on separate line |
| 11752 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 11753 | (setq comment (substring type (match-beginning 2))) |
| 11754 | (setq type (substring type 0 (match-beginning 1)))) |
| 11755 | ;; strip off trailing group-comment |
| 11756 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 11757 | (setq type (substring type 0 (match-end 1))) |
| 11758 | ;; parse initialization expression |
| 11759 | (setq init nil) |
| 11760 | (when (vhdl-parse-string ":=[ \t\n]*" t) |
| 11761 | (vhdl-parse-string "\\([^();\n]*\\)") |
| 11762 | (setq init (match-string-no-properties 1)) |
| 11763 | (while (looking-at "(") |
| 11764 | (setq init |
| 11765 | (concat init |
| 11766 | (buffer-substring-no-properties |
| 11767 | (point) (progn (forward-sexp) (point))) |
| 11768 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 11769 | (match-string-no-properties 1)))))) |
| 11770 | ;; special case: closing parenthesis is on separate line |
| 11771 | (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) |
| 11772 | (setq comment (substring init (match-beginning 2))) |
| 11773 | (setq init (substring init 0 (match-beginning 1))) |
| 11774 | (vhdl-forward-syntactic-ws)) |
| 11775 | (skip-chars-forward " \t") |
| 11776 | ;; parse inline comment, special case: as above, no initial. |
| 11777 | (unless comment |
| 11778 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11779 | (match-string-no-properties 1)))) |
| 11780 | (vhdl-forward-syntactic-ws) |
| 11781 | (setq end-of-list (vhdl-parse-string ")\\s-*" t)) |
| 11782 | ;; parse inline comment |
| 11783 | (unless comment |
| 11784 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11785 | (match-string-no-properties 1)))) |
| 11786 | (setq return-group-comment (vhdl-parse-group-comment)) |
| 11787 | (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") |
| 11788 | ;; parse return type |
| 11789 | (when (match-string 3) |
| 11790 | (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*") |
| 11791 | (setq return-type (match-string-no-properties 1)) |
| 11792 | (when (and return-type |
| 11793 | (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) |
| 11794 | (setq return-comment (substring return-type (match-beginning 2))) |
| 11795 | (setq return-type (substring return-type 0 (match-beginning 1)))) |
| 11796 | ;; strip of trailing group-comment |
| 11797 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) |
| 11798 | (setq return-type (substring return-type 0 (match-end 1))) |
| 11799 | ;; parse return comment |
| 11800 | (unless return-comment |
| 11801 | (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11802 | (match-string-no-properties 1))))) |
| 11803 | ;; parse inline comment |
| 11804 | (unless comment |
| 11805 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11806 | (match-string-no-properties 1)))) |
| 11807 | ;; save everything in list |
| 11808 | (setq param-list (append param-list |
| 11809 | (list (list names object direct type init |
| 11810 | comment group-comment)))) |
| 11811 | ;; parse group comment and spacing |
| 11812 | (setq group-comment (vhdl-parse-group-comment))) |
| 11813 | (message "Reading interface of subprogram \"%s\"...done" name) |
| 11814 | nil))) |
| 11815 | ;; finish parsing |
| 11816 | (if parse-error |
| 11817 | (error parse-error) |
| 11818 | (setq vhdl-subprog-list |
| 11819 | (list name kind param-list return-type return-comment |
| 11820 | return-group-comment) |
| 11821 | vhdl-subprog-flattened nil))))) |
| 11822 | |
| 11823 | (defun vhdl-subprog-paste-specification (kind) |
| 11824 | "Paste as a subprogram specification." |
| 11825 | (indent-according-to-mode) |
| 11826 | (let ((margin (current-column)) |
| 11827 | (param-list (nth 2 vhdl-subprog-list)) |
| 11828 | list-margin start names param) |
| 11829 | ;; paste keyword and name |
| 11830 | (vhdl-insert-keyword |
| 11831 | (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) |
| 11832 | (insert (nth 0 vhdl-subprog-list)) |
| 11833 | (if (not param-list) |
| 11834 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) |
| 11835 | (setq start (point)) |
| 11836 | ;; paste parameter list |
| 11837 | (insert " (") |
| 11838 | (unless vhdl-argument-list-indent |
| 11839 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11840 | (setq list-margin (current-column)) |
| 11841 | (while param-list |
| 11842 | (setq param (car param-list)) |
| 11843 | ;; paste group comment and spacing |
| 11844 | (when (memq vhdl-include-group-comments (list kind 'always)) |
| 11845 | (vhdl-paste-group-comment (nth 6 param) list-margin)) |
| 11846 | ;; paste object |
| 11847 | (when (nth 1 param) (insert (nth 1 param) " ")) |
| 11848 | ;; paste names |
| 11849 | (setq names (nth 0 param)) |
| 11850 | (while names |
| 11851 | (insert (car names)) |
| 11852 | (setq names (cdr names)) |
| 11853 | (when names (insert ", "))) |
| 11854 | ;; paste direction |
| 11855 | (insert " : ") |
| 11856 | (when (nth 2 param) (insert (nth 2 param) " ")) |
| 11857 | ;; paste type |
| 11858 | (insert (nth 3 param)) |
| 11859 | ;; paste initialization |
| 11860 | (when (nth 4 param) (insert " := " (nth 4 param))) |
| 11861 | ;; terminate line |
| 11862 | (if (cdr param-list) |
| 11863 | (insert ";") |
| 11864 | (insert ")") |
| 11865 | (when (null (nth 3 vhdl-subprog-list)) |
| 11866 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) |
| 11867 | ;; paste comment |
| 11868 | (when (and vhdl-include-port-comments (nth 5 param)) |
| 11869 | (vhdl-comment-insert-inline (nth 5 param) t)) |
| 11870 | (setq param-list (cdr param-list)) |
| 11871 | (when param-list (insert "\n") (indent-to list-margin))) |
| 11872 | (when (nth 3 vhdl-subprog-list) |
| 11873 | (insert "\n") (indent-to list-margin) |
| 11874 | ;; paste group comment and spacing |
| 11875 | (when (memq vhdl-include-group-comments (list kind 'always)) |
| 11876 | (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) |
| 11877 | ;; paste return type |
| 11878 | (insert "return " (nth 3 vhdl-subprog-list)) |
| 11879 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) |
| 11880 | (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) |
| 11881 | (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) |
| 11882 | ;; align parameter list |
| 11883 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) |
| 11884 | ;; paste body |
| 11885 | (when (eq kind 'body) |
| 11886 | (insert "\n") |
| 11887 | (vhdl-template-begin-end |
| 11888 | (unless (vhdl-standard-p '87) |
| 11889 | (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) |
| 11890 | (nth 0 vhdl-subprog-list) margin)))) |
| 11891 | |
| 11892 | (defun vhdl-subprog-paste-declaration () |
| 11893 | "Paste as a subprogram declaration." |
| 11894 | (interactive) |
| 11895 | (if (not vhdl-subprog-list) |
| 11896 | (error "ERROR: No subprogram interface read") |
| 11897 | (message "Pasting interface as subprogram declaration \"%s\"..." |
| 11898 | (car vhdl-subprog-list)) |
| 11899 | ;; paste specification |
| 11900 | (vhdl-subprog-paste-specification 'decl) |
| 11901 | (message "Pasting interface as subprogram declaration \"%s\"...done" |
| 11902 | (car vhdl-subprog-list)))) |
| 11903 | |
| 11904 | (defun vhdl-subprog-paste-body () |
| 11905 | "Paste as a subprogram body." |
| 11906 | (interactive) |
| 11907 | (if (not vhdl-subprog-list) |
| 11908 | (error "ERROR: No subprogram interface read") |
| 11909 | (message "Pasting interface as subprogram body \"%s\"..." |
| 11910 | (car vhdl-subprog-list)) |
| 11911 | ;; paste specification and body |
| 11912 | (vhdl-subprog-paste-specification 'body) |
| 11913 | (message "Pasting interface as subprogram body \"%s\"...done" |
| 11914 | (car vhdl-subprog-list)))) |
| 11915 | |
| 11916 | (defun vhdl-subprog-paste-call () |
| 11917 | "Paste as a subprogram call." |
| 11918 | (interactive) |
| 11919 | (if (not vhdl-subprog-list) |
| 11920 | (error "ERROR: No subprogram interface read") |
| 11921 | (let ((orig-vhdl-subprog-list vhdl-subprog-list) |
| 11922 | param-list margin list-margin param start) |
| 11923 | ;; flatten local copy of interface list (must be flat for parameter mapping) |
| 11924 | (vhdl-subprog-flatten) |
| 11925 | (setq param-list (nth 2 vhdl-subprog-list)) |
| 11926 | (indent-according-to-mode) |
| 11927 | (setq margin (current-indentation)) |
| 11928 | (message "Pasting interface as subprogram call \"%s\"..." |
| 11929 | (car vhdl-subprog-list)) |
| 11930 | ;; paste name |
| 11931 | (insert (nth 0 vhdl-subprog-list)) |
| 11932 | (if (not param-list) |
| 11933 | (insert ";") |
| 11934 | (setq start (point)) |
| 11935 | ;; paste parameter list |
| 11936 | (insert " (") |
| 11937 | (unless vhdl-argument-list-indent |
| 11938 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11939 | (setq list-margin (current-column)) |
| 11940 | (while param-list |
| 11941 | (setq param (car param-list)) |
| 11942 | ;; paste group comment and spacing |
| 11943 | (when (eq vhdl-include-group-comments 'always) |
| 11944 | (vhdl-paste-group-comment (nth 6 param) list-margin)) |
| 11945 | ;; paste formal port |
| 11946 | (insert (car (nth 0 param)) " => ") |
| 11947 | (setq param-list (cdr param-list)) |
| 11948 | (insert (if param-list "," ");")) |
| 11949 | ;; paste comment |
| 11950 | (when (and vhdl-include-port-comments (nth 5 param)) |
| 11951 | (vhdl-comment-insert-inline (nth 5 param))) |
| 11952 | (when param-list (insert "\n") (indent-to list-margin))) |
| 11953 | ;; align parameter list |
| 11954 | (when vhdl-auto-align |
| 11955 | (vhdl-align-region-groups start (point) 1))) |
| 11956 | (message "Pasting interface as subprogram call \"%s\"...done" |
| 11957 | (car vhdl-subprog-list)) |
| 11958 | (setq vhdl-subprog-list orig-vhdl-subprog-list)))) |
| 11959 | |
| 11960 | |
| 11961 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11962 | ;;; Miscellaneous |
| 11963 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11964 | |
| 11965 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11966 | ;; Hippie expand customization |
| 11967 | |
| 11968 | (defvar vhdl-expand-upper-case nil) |
| 11969 | |
| 11970 | (defun vhdl-try-expand-abbrev (old) |
| 11971 | "Try expanding abbreviations from `vhdl-abbrev-list'." |
| 11972 | (unless old |
| 11973 | (he-init-string (he-dabbrev-beg) (point)) |
| 11974 | (setq he-expand-list |
| 11975 | (let ((abbrev-list vhdl-abbrev-list) |
| 11976 | (sel-abbrev-list '())) |
| 11977 | (while abbrev-list |
| 11978 | (when (or (not (stringp (car abbrev-list))) |
| 11979 | (string-match |
| 11980 | (concat "^" he-search-string) (car abbrev-list))) |
| 11981 | (setq sel-abbrev-list |
| 11982 | (cons (car abbrev-list) sel-abbrev-list))) |
| 11983 | (setq abbrev-list (cdr abbrev-list))) |
| 11984 | (nreverse sel-abbrev-list)))) |
| 11985 | (while (and he-expand-list |
| 11986 | (or (not (stringp (car he-expand-list))) |
| 11987 | (he-string-member (car he-expand-list) he-tried-table t))) |
| 11988 | ; (equal (car he-expand-list) he-search-string))) |
| 11989 | (unless (stringp (car he-expand-list)) |
| 11990 | (setq vhdl-expand-upper-case (car he-expand-list))) |
| 11991 | (setq he-expand-list (cdr he-expand-list))) |
| 11992 | (if (null he-expand-list) |
| 11993 | (progn (when old (he-reset-string)) |
| 11994 | nil) |
| 11995 | (he-substitute-string |
| 11996 | (if vhdl-expand-upper-case |
| 11997 | (upcase (car he-expand-list)) |
| 11998 | (car he-expand-list)) |
| 11999 | t) |
| 12000 | (setq he-expand-list (cdr he-expand-list)) |
| 12001 | t)) |
| 12002 | |
| 12003 | (defun vhdl-he-list-beg () |
| 12004 | "Also looks at the word before `(' in order to better match parenthesized |
| 12005 | expressions (e.g. for index ranges of types and signals)." |
| 12006 | (save-excursion |
| 12007 | (condition-case () |
| 12008 | (progn (backward-up-list 1) |
| 12009 | (skip-syntax-backward "w_")) ; crashes in `viper-mode' |
| 12010 | (error ())) |
| 12011 | (point))) |
| 12012 | |
| 12013 | ;; override `he-list-beg' from `hippie-exp' |
| 12014 | (unless (and (boundp 'viper-mode) viper-mode) |
| 12015 | (defalias 'he-list-beg 'vhdl-he-list-beg)) |
| 12016 | |
| 12017 | ;; function for expanding abbrevs and dabbrevs |
| 12018 | (defun vhdl-expand-abbrev (arg)) |
| 12019 | (fset 'vhdl-expand-abbrev (make-hippie-expand-function |
| 12020 | '(try-expand-dabbrev |
| 12021 | try-expand-dabbrev-all-buffers |
| 12022 | vhdl-try-expand-abbrev))) |
| 12023 | |
| 12024 | ;; function for expanding parenthesis |
| 12025 | (defun vhdl-expand-paren (arg)) |
| 12026 | (fset 'vhdl-expand-paren (make-hippie-expand-function |
| 12027 | '(try-expand-list |
| 12028 | try-expand-list-all-buffers))) |
| 12029 | |
| 12030 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12031 | ;; Case fixing |
| 12032 | |
| 12033 | (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) |
| 12034 | "Convert all words matching WORD-REGEXP in region to lower or upper case, |
| 12035 | depending on parameter UPPER-CASE." |
| 12036 | (let ((case-replace nil) |
| 12037 | (last-update 0)) |
| 12038 | (vhdl-prepare-search-2 |
| 12039 | (save-excursion |
| 12040 | (goto-char end) |
| 12041 | (setq end (point-marker)) |
| 12042 | (goto-char beg) |
| 12043 | (while (re-search-forward word-regexp end t) |
| 12044 | (or (vhdl-in-literal) |
| 12045 | (if upper-case |
| 12046 | (upcase-word -1) |
| 12047 | (downcase-word -1))) |
| 12048 | (when (and count vhdl-progress-interval (not noninteractive) |
| 12049 | (< vhdl-progress-interval |
| 12050 | (- (nth 1 (current-time)) last-update))) |
| 12051 | (message "Fixing case... (%2d%s)" |
| 12052 | (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg))) |
| 12053 | "%") |
| 12054 | (setq last-update (nth 1 (current-time))))) |
| 12055 | (goto-char end))))) |
| 12056 | |
| 12057 | (defun vhdl-fix-case-region (beg end &optional arg) |
| 12058 | "Convert all VHDL words in region to lower or upper case, depending on |
| 12059 | options vhdl-upper-case-{keywords,types,attributes,enum-values}." |
| 12060 | (interactive "r\nP") |
| 12061 | (vhdl-fix-case-region-1 |
| 12062 | beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) |
| 12063 | (vhdl-fix-case-region-1 |
| 12064 | beg end vhdl-upper-case-types vhdl-types-regexp 1) |
| 12065 | (vhdl-fix-case-region-1 |
| 12066 | beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) |
| 12067 | (vhdl-fix-case-region-1 |
| 12068 | beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) |
| 12069 | (when vhdl-progress-interval (message "Fixing case...done"))) |
| 12070 | |
| 12071 | (defun vhdl-fix-case-buffer () |
| 12072 | "Convert all VHDL words in buffer to lower or upper case, depending on |
| 12073 | options vhdl-upper-case-{keywords,types,attributes,enum-values}." |
| 12074 | (interactive) |
| 12075 | (vhdl-fix-case-region (point-min) (point-max))) |
| 12076 | |
| 12077 | (defun vhdl-fix-case-word (&optional arg) |
| 12078 | "Convert word after cursor to upper case if necessary." |
| 12079 | (interactive "p") |
| 12080 | (save-excursion |
| 12081 | (when arg (backward-word 1)) |
| 12082 | (vhdl-prepare-search-1 |
| 12083 | (when (and vhdl-upper-case-keywords |
| 12084 | (looking-at vhdl-keywords-regexp)) |
| 12085 | (upcase-word 1)) |
| 12086 | (when (and vhdl-upper-case-types |
| 12087 | (looking-at vhdl-types-regexp)) |
| 12088 | (upcase-word 1)) |
| 12089 | (when (and vhdl-upper-case-attributes |
| 12090 | (looking-at vhdl-attributes-regexp)) |
| 12091 | (upcase-word 1)) |
| 12092 | (when (and vhdl-upper-case-enum-values |
| 12093 | (looking-at vhdl-enum-values-regexp)) |
| 12094 | (upcase-word 1))))) |
| 12095 | |
| 12096 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12097 | ;; Line handling functions |
| 12098 | |
| 12099 | (defun vhdl-current-line () |
| 12100 | "Return the line number of the line containing point." |
| 12101 | (save-restriction |
| 12102 | (widen) |
| 12103 | (1+ (count-lines (point-min) (point-at-bol))))) |
| 12104 | |
| 12105 | (defun vhdl-line-kill-entire (&optional arg) |
| 12106 | "Delete entire line." |
| 12107 | (interactive "p") |
| 12108 | (beginning-of-line) |
| 12109 | (kill-line (or arg 1))) |
| 12110 | |
| 12111 | (defun vhdl-line-kill (&optional arg) |
| 12112 | "Kill current line." |
| 12113 | (interactive "p") |
| 12114 | (vhdl-line-kill-entire arg)) |
| 12115 | |
| 12116 | (defun vhdl-line-copy (&optional arg) |
| 12117 | "Copy current line." |
| 12118 | (interactive "p") |
| 12119 | (save-excursion |
| 12120 | (let ((position (point-at-bol))) |
| 12121 | (forward-line (or arg 1)) |
| 12122 | (copy-region-as-kill position (point))))) |
| 12123 | |
| 12124 | (defun vhdl-line-yank () |
| 12125 | "Yank entire line." |
| 12126 | (interactive) |
| 12127 | (beginning-of-line) |
| 12128 | (yank)) |
| 12129 | |
| 12130 | (defun vhdl-line-expand (&optional prefix-arg) |
| 12131 | "Hippie-expand current line." |
| 12132 | (interactive "P") |
| 12133 | (let ((case-fold-search t) (case-replace nil) |
| 12134 | (hippie-expand-try-functions-list |
| 12135 | '(try-expand-line try-expand-line-all-buffers))) |
| 12136 | (hippie-expand prefix-arg))) |
| 12137 | |
| 12138 | (defun vhdl-line-transpose-next (&optional arg) |
| 12139 | "Interchange this line with next line." |
| 12140 | (interactive "p") |
| 12141 | (forward-line 1) |
| 12142 | (transpose-lines (or arg 1)) |
| 12143 | (forward-line -1)) |
| 12144 | |
| 12145 | (defun vhdl-line-transpose-previous (&optional arg) |
| 12146 | "Interchange this line with previous line." |
| 12147 | (interactive "p") |
| 12148 | (forward-line 1) |
| 12149 | (transpose-lines (- 0 (or arg 0))) |
| 12150 | (forward-line -1)) |
| 12151 | |
| 12152 | (defun vhdl-line-open () |
| 12153 | "Open a new line and indent." |
| 12154 | (interactive) |
| 12155 | (end-of-line -0) |
| 12156 | (newline-and-indent)) |
| 12157 | |
| 12158 | (defun vhdl-delete-indentation () |
| 12159 | "Join lines. That is, call `delete-indentation' with `fill-prefix' so that |
| 12160 | it works within comments too." |
| 12161 | (interactive) |
| 12162 | (let ((fill-prefix "-- ")) |
| 12163 | (delete-indentation))) |
| 12164 | |
| 12165 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12166 | ;; Move functions |
| 12167 | |
| 12168 | (defun vhdl-forward-same-indent () |
| 12169 | "Move forward to next line with same indent." |
| 12170 | (interactive) |
| 12171 | (let ((pos (point)) |
| 12172 | (indent (current-indentation))) |
| 12173 | (beginning-of-line 2) |
| 12174 | (while (and (not (eobp)) |
| 12175 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 12176 | (> (current-indentation) indent))) |
| 12177 | (beginning-of-line 2)) |
| 12178 | (if (= (current-indentation) indent) |
| 12179 | (back-to-indentation) |
| 12180 | (message "No following line with same indent found in this block") |
| 12181 | (goto-char pos) |
| 12182 | nil))) |
| 12183 | |
| 12184 | (defun vhdl-backward-same-indent () |
| 12185 | "Move backward to previous line with same indent." |
| 12186 | (interactive) |
| 12187 | (let ((pos (point)) |
| 12188 | (indent (current-indentation))) |
| 12189 | (beginning-of-line -0) |
| 12190 | (while (and (not (bobp)) |
| 12191 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 12192 | (> (current-indentation) indent))) |
| 12193 | (beginning-of-line -0)) |
| 12194 | (if (= (current-indentation) indent) |
| 12195 | (back-to-indentation) |
| 12196 | (message "No preceding line with same indent found in this block") |
| 12197 | (goto-char pos) |
| 12198 | nil))) |
| 12199 | |
| 12200 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12201 | ;; Statistics |
| 12202 | |
| 12203 | (defun vhdl-statistics-buffer () |
| 12204 | "Get some file statistics." |
| 12205 | (interactive) |
| 12206 | (let ((no-stats 0) |
| 12207 | (no-code-lines 0) |
| 12208 | (no-lines (count-lines (point-min) (point-max)))) |
| 12209 | (save-excursion |
| 12210 | ;; count statements |
| 12211 | (goto-char (point-min)) |
| 12212 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) |
| 12213 | (if (match-string 1) |
| 12214 | (goto-char (match-end 1)) |
| 12215 | (setq no-stats (1+ no-stats)))) |
| 12216 | ;; count code lines |
| 12217 | (goto-char (point-min)) |
| 12218 | (while (not (eobp)) |
| 12219 | (unless (looking-at "^\\s-*\\(--.*\\)?$") |
| 12220 | (setq no-code-lines (1+ no-code-lines))) |
| 12221 | (beginning-of-line 2))) |
| 12222 | ;; print results |
| 12223 | (message "\n\ |
| 12224 | File statistics: \"%s\"\n\ |
| 12225 | ---------------------\n\ |
| 12226 | # statements : %5d\n\ |
| 12227 | # code lines : %5d\n\ |
| 12228 | # total lines : %5d\n\ " |
| 12229 | (buffer-file-name) no-stats no-code-lines no-lines) |
| 12230 | (unless vhdl-emacs-21 (vhdl-show-messages)))) |
| 12231 | |
| 12232 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12233 | ;; Help functions |
| 12234 | |
| 12235 | (defun vhdl-re-search-forward (regexp &optional bound noerror count) |
| 12236 | "Like `re-search-forward', but does not match within literals." |
| 12237 | (let (pos) |
| 12238 | (save-excursion |
| 12239 | (while (and (setq pos (re-search-forward regexp bound noerror count)) |
| 12240 | (vhdl-in-literal)))) |
| 12241 | (when pos (goto-char pos)) |
| 12242 | pos)) |
| 12243 | |
| 12244 | (defun vhdl-re-search-backward (regexp &optional bound noerror count) |
| 12245 | "Like `re-search-backward', but does not match within literals." |
| 12246 | (let (pos) |
| 12247 | (save-excursion |
| 12248 | (while (and (setq pos (re-search-backward regexp bound noerror count)) |
| 12249 | (vhdl-in-literal)))) |
| 12250 | (when pos (goto-char pos)) |
| 12251 | pos)) |
| 12252 | |
| 12253 | |
| 12254 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12255 | ;;; Project |
| 12256 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12257 | |
| 12258 | (defun vhdl-set-project (name) |
| 12259 | "Set current project to NAME." |
| 12260 | (interactive |
| 12261 | (list (let ((completion-ignore-case t)) |
| 12262 | (completing-read "Project name: " vhdl-project-alist nil t)))) |
| 12263 | (cond ((equal name "") |
| 12264 | (setq vhdl-project nil) |
| 12265 | (message "Current VHDL project: None")) |
| 12266 | ((assoc name vhdl-project-alist) |
| 12267 | (setq vhdl-project name) |
| 12268 | (message "Current VHDL project: \"%s\"" name)) |
| 12269 | (t |
| 12270 | (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) |
| 12271 | (vhdl-speedbar-update-current-project)) |
| 12272 | |
| 12273 | (defun vhdl-set-default-project () |
| 12274 | "Set current project as default on startup." |
| 12275 | (interactive) |
| 12276 | (customize-set-variable 'vhdl-project vhdl-project) |
| 12277 | (customize-save-customized)) |
| 12278 | |
| 12279 | (defun vhdl-toggle-project (name token indent) |
| 12280 | "Set current project to NAME or unset if NAME is current project." |
| 12281 | (vhdl-set-project (if (equal name vhdl-project) "" name))) |
| 12282 | |
| 12283 | (defun vhdl-export-project (file-name) |
| 12284 | "Write project setup for current project." |
| 12285 | (interactive |
| 12286 | (let ((name (vhdl-resolve-env-variable |
| 12287 | (vhdl-replace-string |
| 12288 | (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) |
| 12289 | (concat (subst-char-in-string |
| 12290 | ? ?_ (or (vhdl-project-p) |
| 12291 | (error "ERROR: No current project"))) |
| 12292 | " " (user-login-name)))))) |
| 12293 | (list (read-file-name |
| 12294 | "Write project file: " |
| 12295 | (when (file-name-absolute-p name) "") nil nil name)))) |
| 12296 | (setq file-name (abbreviate-file-name file-name)) |
| 12297 | (let ((orig-buffer (current-buffer))) |
| 12298 | (unless (file-exists-p (file-name-directory file-name)) |
| 12299 | (make-directory (file-name-directory file-name) t)) |
| 12300 | (if (not (file-writable-p file-name)) |
| 12301 | (error "ERROR: File not writable: \"%s\"" file-name) |
| 12302 | (set-buffer (find-file-noselect file-name t t)) |
| 12303 | (erase-buffer) |
| 12304 | (insert ";; -*- Emacs-Lisp -*-\n\n" |
| 12305 | ";;; " (file-name-nondirectory file-name) |
| 12306 | " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" |
| 12307 | ";; Project : " vhdl-project "\n" |
| 12308 | ";; Saved : " (format-time-string "%Y-%m-%d %T ") |
| 12309 | (user-login-name) "\n\n\n" |
| 12310 | ";; project name\n" |
| 12311 | "(setq vhdl-project \"" vhdl-project "\")\n\n" |
| 12312 | ";; project setup\n" |
| 12313 | "(aput 'vhdl-project-alist vhdl-project\n'") |
| 12314 | (pp (aget vhdl-project-alist vhdl-project) (current-buffer)) |
| 12315 | (insert ")\n") |
| 12316 | (save-buffer) |
| 12317 | (kill-buffer (current-buffer)) |
| 12318 | (set-buffer orig-buffer)))) |
| 12319 | |
| 12320 | (defun vhdl-import-project (file-name &optional auto not-make-current) |
| 12321 | "Read project setup and set current project." |
| 12322 | (interactive |
| 12323 | (let ((name (vhdl-resolve-env-variable |
| 12324 | (vhdl-replace-string |
| 12325 | (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) |
| 12326 | (concat "" " " (user-login-name)))))) |
| 12327 | (list (read-file-name |
| 12328 | "Read project file: " (when (file-name-absolute-p name) "") nil t |
| 12329 | (file-name-directory name))))) |
| 12330 | (when (file-exists-p file-name) |
| 12331 | (condition-case () |
| 12332 | (let ((current-project vhdl-project)) |
| 12333 | (load-file file-name) |
| 12334 | (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10) |
| 12335 | (adelete 'vhdl-project-alist vhdl-project) |
| 12336 | (error "")) |
| 12337 | (when not-make-current |
| 12338 | (setq vhdl-project current-project)) |
| 12339 | (vhdl-update-mode-menu) |
| 12340 | (vhdl-speedbar-refresh) |
| 12341 | (unless not-make-current |
| 12342 | (message "Current VHDL project: \"%s\"%s" |
| 12343 | vhdl-project (if auto " (auto-loaded)" "")))) |
| 12344 | (error (vhdl-warning |
| 12345 | (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) |
| 12346 | |
| 12347 | (defun vhdl-duplicate-project () |
| 12348 | "Duplicate setup of current project." |
| 12349 | (interactive) |
| 12350 | (let ((new-name (read-from-minibuffer "New project name: ")) |
| 12351 | (project-entry (aget vhdl-project-alist vhdl-project t))) |
| 12352 | (setq vhdl-project-alist |
| 12353 | (append vhdl-project-alist |
| 12354 | (list (cons new-name project-entry)))) |
| 12355 | (vhdl-update-mode-menu))) |
| 12356 | |
| 12357 | (defun vhdl-auto-load-project () |
| 12358 | "Automatically load project setup at startup." |
| 12359 | (let ((file-name-list vhdl-project-file-name) |
| 12360 | file-list list-length) |
| 12361 | (while file-name-list |
| 12362 | (setq file-list |
| 12363 | (append file-list |
| 12364 | (file-expand-wildcards |
| 12365 | (vhdl-resolve-env-variable |
| 12366 | (vhdl-replace-string |
| 12367 | (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) |
| 12368 | (concat "\*" " " (user-login-name))))))) |
| 12369 | (setq list-length (or list-length (length file-list))) |
| 12370 | (setq file-name-list (cdr file-name-list))) |
| 12371 | (while file-list |
| 12372 | (vhdl-import-project (expand-file-name (car file-list)) t |
| 12373 | (not (> list-length 0))) |
| 12374 | (setq list-length (1- list-length)) |
| 12375 | (setq file-list (cdr file-list))))) |
| 12376 | |
| 12377 | ;; automatically load project setup when idle after startup |
| 12378 | (when (memq 'startup vhdl-project-auto-load) |
| 12379 | (if noninteractive |
| 12380 | (vhdl-auto-load-project) |
| 12381 | (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project))) |
| 12382 | |
| 12383 | |
| 12384 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12385 | ;;; Hideshow |
| 12386 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12387 | ;; (using `hideshow.el') |
| 12388 | |
| 12389 | (defconst vhdl-hs-start-regexp |
| 12390 | (concat |
| 12391 | "\\(^\\)\\s-*\\(" |
| 12392 | ;; generic/port clause |
| 12393 | "\\(generic\\|port\\)[ \t\n]*(\\|" |
| 12394 | ;; component |
| 12395 | "component\\>\\|" |
| 12396 | ;; component instantiation |
| 12397 | "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*" |
| 12398 | "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?" |
| 12399 | "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*" |
| 12400 | "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|" |
| 12401 | ;; subprogram |
| 12402 | "\\(function\\|procedure\\)\\>\\|" |
| 12403 | ;; process, block |
| 12404 | "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|" |
| 12405 | ;; configuration declaration |
| 12406 | "configuration\\>" |
| 12407 | "\\)") |
| 12408 | "Regexp to match start of construct to hide.") |
| 12409 | |
| 12410 | (defun vhdl-hs-forward-sexp-func (count) |
| 12411 | "Find end of construct to hide (for hideshow). Only searches forward." |
| 12412 | (let ((pos (point))) |
| 12413 | (vhdl-prepare-search-2 |
| 12414 | (beginning-of-line) |
| 12415 | (cond |
| 12416 | ;; generic/port clause |
| 12417 | ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(") |
| 12418 | (goto-char (match-end 0)) |
| 12419 | (backward-char) |
| 12420 | (forward-sexp)) |
| 12421 | ;; component declaration |
| 12422 | ((looking-at "^\\s-*component\\>") |
| 12423 | (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) |
| 12424 | ;; component instantiation |
| 12425 | ((looking-at |
| 12426 | (concat |
| 12427 | "^\\s-*\\w+\\s-*:[ \t\n]*" |
| 12428 | "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?" |
| 12429 | "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*" |
| 12430 | "\\(generic\\|port\\)\\s-+map[ \t\n]*(")) |
| 12431 | (goto-char (match-end 0)) |
| 12432 | (backward-char) |
| 12433 | (forward-sexp) |
| 12434 | (setq pos (point)) |
| 12435 | (vhdl-forward-syntactic-ws) |
| 12436 | (when (looking-at "port\\s-+map[ \t\n]*(") |
| 12437 | (goto-char (match-end 0)) |
| 12438 | (backward-char) |
| 12439 | (forward-sexp) |
| 12440 | (setq pos (point))) |
| 12441 | (goto-char pos)) |
| 12442 | ;; subprogram declaration/body |
| 12443 | ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") |
| 12444 | (goto-char (match-end 0)) |
| 12445 | (vhdl-forward-syntactic-ws) |
| 12446 | (when (looking-at "(") |
| 12447 | (forward-sexp)) |
| 12448 | (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) |
| 12449 | (vhdl-in-literal))) |
| 12450 | ;; subprogram body |
| 12451 | (when (match-string 2) |
| 12452 | (re-search-forward "^\\s-*\\<begin\\>" nil t) |
| 12453 | (backward-word 1) |
| 12454 | (vhdl-forward-sexp))) |
| 12455 | ;; block (recursive) |
| 12456 | ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") |
| 12457 | (goto-char (match-end 0)) |
| 12458 | (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) |
| 12459 | (match-beginning 2)) |
| 12460 | (vhdl-hs-forward-sexp-func count))) |
| 12461 | ;; process |
| 12462 | ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") |
| 12463 | (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) |
| 12464 | ;; configuration declaration |
| 12465 | ((looking-at "^\\s-*configuration\\>") |
| 12466 | (forward-word 4) |
| 12467 | (vhdl-forward-sexp)) |
| 12468 | (t (goto-char pos)))))) |
| 12469 | |
| 12470 | (defun vhdl-hideshow-init () |
| 12471 | "Initialize `hideshow'." |
| 12472 | (when vhdl-hideshow-menu |
| 12473 | (vhdl-hs-minor-mode 1))) |
| 12474 | |
| 12475 | (defun vhdl-hs-minor-mode (&optional arg) |
| 12476 | "Toggle hideshow minor mode and update menu bar." |
| 12477 | (interactive "P") |
| 12478 | (require 'hideshow) |
| 12479 | ;; check for hideshow version 5.x |
| 12480 | (if (not (boundp 'hs-block-start-mdata-select)) |
| 12481 | (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") |
| 12482 | ;; initialize hideshow |
| 12483 | (unless (assoc 'vhdl-mode hs-special-modes-alist) |
| 12484 | (setq hs-special-modes-alist |
| 12485 | (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" |
| 12486 | 'vhdl-hs-forward-sexp-func nil) |
| 12487 | hs-special-modes-alist))) |
| 12488 | (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) |
| 12489 | (if vhdl-hide-all-init |
| 12490 | (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) |
| 12491 | (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) |
| 12492 | (hs-minor-mode arg) |
| 12493 | (force-mode-line-update))) ; hack to update menu bar |
| 12494 | |
| 12495 | |
| 12496 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12497 | ;;; Font locking |
| 12498 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12499 | ;; (using `font-lock.el') |
| 12500 | |
| 12501 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12502 | ;; Help functions |
| 12503 | |
| 12504 | (defun vhdl-within-translate-off () |
| 12505 | "Return point if within translate-off region, else nil." |
| 12506 | (and (save-excursion |
| 12507 | (re-search-backward |
| 12508 | "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) |
| 12509 | (equal "off" (match-string 1)) |
| 12510 | (point))) |
| 12511 | |
| 12512 | (defun vhdl-start-translate-off (limit) |
| 12513 | "Return point before translate-off pragma if before LIMIT, else nil." |
| 12514 | (when (re-search-forward |
| 12515 | "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) |
| 12516 | (match-beginning 0))) |
| 12517 | |
| 12518 | (defun vhdl-end-translate-off (limit) |
| 12519 | "Return point after translate-on pragma if before LIMIT, else nil." |
| 12520 | (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) |
| 12521 | |
| 12522 | (defun vhdl-match-translate-off (limit) |
| 12523 | "Match a translate-off block, setting match-data and returning t, else nil." |
| 12524 | (when (< (point) limit) |
| 12525 | (let ((start (or (vhdl-within-translate-off) |
| 12526 | (vhdl-start-translate-off limit))) |
| 12527 | (case-fold-search t)) |
| 12528 | (when start |
| 12529 | (let ((end (or (vhdl-end-translate-off limit) limit))) |
| 12530 | (set-match-data (list start end)) |
| 12531 | (goto-char end)))))) |
| 12532 | |
| 12533 | (defun vhdl-font-lock-match-item (limit) |
| 12534 | "Match, and move over, any declaration item after point. Adapted from |
| 12535 | `font-lock-match-c-style-declaration-item-and-skip-to-next'." |
| 12536 | (condition-case nil |
| 12537 | (save-restriction |
| 12538 | (narrow-to-region (point-min) limit) |
| 12539 | ;; match item |
| 12540 | (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") |
| 12541 | (save-match-data |
| 12542 | (goto-char (match-end 1)) |
| 12543 | ;; move to next item |
| 12544 | (if (looking-at "\\(\\s-*,\\)") |
| 12545 | (goto-char (match-end 1)) |
| 12546 | (end-of-line) t)))) |
| 12547 | (error t))) |
| 12548 | |
| 12549 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12550 | ;; Syntax definitions |
| 12551 | |
| 12552 | (defconst vhdl-font-lock-syntactic-keywords |
| 12553 | '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\')))) |
| 12554 | "Mark single quotes as having string quote syntax in 'c' instances.") |
| 12555 | |
| 12556 | (defvar vhdl-font-lock-keywords nil |
| 12557 | "Regular expressions to highlight in VHDL Mode.") |
| 12558 | |
| 12559 | (defvar vhdl-font-lock-keywords-0 |
| 12560 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 12561 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12562 | This does highlighting of template prompts and directives (pragmas).") |
| 12563 | |
| 12564 | (defvar vhdl-font-lock-keywords-1 nil |
| 12565 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 12566 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12567 | This does highlighting of keywords and standard identifiers.") |
| 12568 | |
| 12569 | (defconst vhdl-font-lock-keywords-2 |
| 12570 | (list |
| 12571 | ;; highlight names of units, subprograms, and components when declared |
| 12572 | (list |
| 12573 | (concat |
| 12574 | "^\\s-*\\(" |
| 12575 | "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|" |
| 12576 | "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" |
| 12577 | "\\)\\s-+\\(\\w+\\)") |
| 12578 | 5 'font-lock-function-name-face) |
| 12579 | |
| 12580 | ;; highlight entity names of architectures and configurations |
| 12581 | (list |
| 12582 | "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" |
| 12583 | 2 'font-lock-function-name-face) |
| 12584 | |
| 12585 | ;; highlight labels of common constructs |
| 12586 | (list |
| 12587 | (concat |
| 12588 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\(" |
| 12589 | "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" |
| 12590 | "postponed\\|process\\|" |
| 12591 | (when (vhdl-standard-p 'ams) "procedural\\|") |
| 12592 | "with\\|while" |
| 12593 | "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") |
| 12594 | 1 'font-lock-function-name-face) |
| 12595 | |
| 12596 | ;; highlight label and component name of component instantiations |
| 12597 | (list |
| 12598 | (concat |
| 12599 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)" |
| 12600 | "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)") |
| 12601 | '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) |
| 12602 | |
| 12603 | ;; highlight label and instantiated unit of component instantiations |
| 12604 | (list |
| 12605 | (concat |
| 12606 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*" |
| 12607 | "\\(component\\|configuration\\|entity\\)\\s-+" |
| 12608 | "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") |
| 12609 | '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) |
| 12610 | '(5 font-lock-function-name-face nil t) |
| 12611 | '(7 font-lock-function-name-face nil t)) |
| 12612 | |
| 12613 | ;; highlight names and labels at end of constructs |
| 12614 | (list |
| 12615 | (concat |
| 12616 | "^\\s-*end\\s-+\\(\\(" |
| 12617 | "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|" |
| 12618 | "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|" |
| 12619 | "procedure\\|\\(postponed\\s-+\\)?process\\|" |
| 12620 | (when (vhdl-standard-p 'ams) "procedural\\|") |
| 12621 | "units" |
| 12622 | "\\)\\s-+\\)?\\(\\w*\\)") |
| 12623 | 5 'font-lock-function-name-face) |
| 12624 | |
| 12625 | ;; highlight labels in exit and next statements |
| 12626 | (list |
| 12627 | (concat |
| 12628 | "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") |
| 12629 | 3 'font-lock-function-name-face) |
| 12630 | |
| 12631 | ;; highlight entity name in attribute specifications |
| 12632 | (list |
| 12633 | (concat |
| 12634 | "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") |
| 12635 | 1 'font-lock-function-name-face) |
| 12636 | |
| 12637 | ;; highlight labels in block and component specifications |
| 12638 | (list |
| 12639 | (concat |
| 12640 | "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" |
| 12641 | "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)") |
| 12642 | '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) |
| 12643 | |
| 12644 | ;; highlight names in library clauses |
| 12645 | (list "^\\s-*library\\>" |
| 12646 | '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) |
| 12647 | |
| 12648 | ;; highlight names in use clauses |
| 12649 | (list |
| 12650 | (concat |
| 12651 | "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" |
| 12652 | "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") |
| 12653 | '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t) |
| 12654 | '(7 font-lock-function-name-face nil t)) |
| 12655 | |
| 12656 | ;; highlight attribute name in attribute declarations/specifications |
| 12657 | (list |
| 12658 | (concat |
| 12659 | "^\\s-*attribute\\s-+\\(\\w+\\)") |
| 12660 | 1 'vhdl-font-lock-attribute-face) |
| 12661 | |
| 12662 | ;; highlight type/nature name in (sub)type/(sub)nature declarations |
| 12663 | (list |
| 12664 | (concat |
| 12665 | "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)") |
| 12666 | 3 'font-lock-type-face) |
| 12667 | |
| 12668 | ;; highlight signal/variable/constant declaration names |
| 12669 | (list "\\(:[^=]\\)" |
| 12670 | '(vhdl-font-lock-match-item |
| 12671 | (progn (goto-char (match-beginning 1)) |
| 12672 | (skip-syntax-backward " ") |
| 12673 | (skip-syntax-backward "w_") |
| 12674 | (skip-syntax-backward " ") |
| 12675 | (while (= (preceding-char) ?,) |
| 12676 | (backward-char 1) |
| 12677 | (skip-syntax-backward " ") |
| 12678 | (skip-syntax-backward "w_") |
| 12679 | (skip-syntax-backward " "))) |
| 12680 | ; (skip-chars-backward "^-(\n\";") |
| 12681 | (goto-char (match-end 1)) (1 font-lock-variable-name-face))) |
| 12682 | |
| 12683 | ;; highlight formal parameters in component instantiations and subprogram |
| 12684 | ;; calls |
| 12685 | (list "\\(=>\\)" |
| 12686 | '(vhdl-font-lock-match-item |
| 12687 | (progn (goto-char (match-beginning 1)) |
| 12688 | (skip-syntax-backward " ") |
| 12689 | (while (= (preceding-char) ?\)) (backward-sexp)) |
| 12690 | (skip-syntax-backward "w_") |
| 12691 | (skip-syntax-backward " ") |
| 12692 | (when (memq (preceding-char) '(?n ?N ?|)) |
| 12693 | (goto-char (point-max)))) |
| 12694 | (goto-char (match-end 1)) (1 font-lock-variable-name-face))) |
| 12695 | |
| 12696 | ;; highlight alias/group/quantity declaration names and for-loop/-generate |
| 12697 | ;; variables |
| 12698 | (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" |
| 12699 | '(vhdl-font-lock-match-item |
| 12700 | (progn (goto-char (match-end 1)) (match-beginning 2)) |
| 12701 | nil (1 font-lock-variable-name-face))) |
| 12702 | ) |
| 12703 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12704 | This does context sensitive highlighting of names and labels.") |
| 12705 | |
| 12706 | (defvar vhdl-font-lock-keywords-3 nil |
| 12707 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 12708 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12709 | This does highlighting of words with special syntax.") |
| 12710 | |
| 12711 | (defvar vhdl-font-lock-keywords-4 nil |
| 12712 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 12713 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12714 | This does highlighting of additional reserved words.") |
| 12715 | |
| 12716 | (defconst vhdl-font-lock-keywords-5 |
| 12717 | ;; background highlight translate-off regions |
| 12718 | '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) |
| 12719 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 12720 | This does background highlighting of translate-off regions.") |
| 12721 | |
| 12722 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12723 | ;; Font and color definitions |
| 12724 | |
| 12725 | (defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face |
| 12726 | "Face name to use for prompts.") |
| 12727 | |
| 12728 | (defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face |
| 12729 | "Face name to use for standardized attributes.") |
| 12730 | |
| 12731 | (defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face |
| 12732 | "Face name to use for standardized enumeration values.") |
| 12733 | |
| 12734 | (defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face |
| 12735 | "Face name to use for standardized functions and packages.") |
| 12736 | |
| 12737 | (defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face |
| 12738 | "Face name to use for directives.") |
| 12739 | |
| 12740 | (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face |
| 12741 | "Face name to use for additional reserved words.") |
| 12742 | |
| 12743 | (defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face |
| 12744 | "Face name to use for translate-off regions.") |
| 12745 | |
| 12746 | ;; face names to use for words with special syntax. |
| 12747 | (let ((syntax-alist vhdl-special-syntax-alist) |
| 12748 | name) |
| 12749 | (while syntax-alist |
| 12750 | (setq name (vhdl-function-name |
| 12751 | "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) |
| 12752 | (eval `(defvar ,name ',name |
| 12753 | ,(concat "Face name to use for " |
| 12754 | (nth 0 (car syntax-alist)) "."))) |
| 12755 | (setq syntax-alist (cdr syntax-alist)))) |
| 12756 | |
| 12757 | (defgroup vhdl-highlight-faces nil |
| 12758 | "Faces for highlighting." |
| 12759 | :group 'vhdl-highlight) |
| 12760 | |
| 12761 | ;; add faces used from `font-lock' |
| 12762 | (custom-add-to-group |
| 12763 | 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) |
| 12764 | (custom-add-to-group |
| 12765 | 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) |
| 12766 | (custom-add-to-group |
| 12767 | 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) |
| 12768 | (custom-add-to-group |
| 12769 | 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) |
| 12770 | (custom-add-to-group |
| 12771 | 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) |
| 12772 | (custom-add-to-group |
| 12773 | 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) |
| 12774 | |
| 12775 | (defface vhdl-font-lock-prompt-face |
| 12776 | '((((min-colors 88) (class color) (background light)) |
| 12777 | (:foreground "Red1" :bold t)) |
| 12778 | (((class color) (background light)) (:foreground "Red" :bold t)) |
| 12779 | (((class color) (background dark)) (:foreground "Pink" :bold t)) |
| 12780 | (t (:inverse-video t))) |
| 12781 | "Font lock mode face used to highlight prompts." |
| 12782 | :group 'vhdl-highlight-faces) |
| 12783 | |
| 12784 | (defface vhdl-font-lock-attribute-face |
| 12785 | '((((class color) (background light)) (:foreground "Orchid")) |
| 12786 | (((class color) (background dark)) (:foreground "LightSteelBlue")) |
| 12787 | (t (:italic t :bold t))) |
| 12788 | "Font lock mode face used to highlight standardized attributes." |
| 12789 | :group 'vhdl-highlight-faces) |
| 12790 | |
| 12791 | (defface vhdl-font-lock-enumvalue-face |
| 12792 | '((((class color) (background light)) (:foreground "SaddleBrown")) |
| 12793 | (((class color) (background dark)) (:foreground "BurlyWood")) |
| 12794 | (t (:italic t :bold t))) |
| 12795 | "Font lock mode face used to highlight standardized enumeration values." |
| 12796 | :group 'vhdl-highlight-faces) |
| 12797 | |
| 12798 | (defface vhdl-font-lock-function-face |
| 12799 | '((((class color) (background light)) (:foreground "Cyan4")) |
| 12800 | (((class color) (background dark)) (:foreground "Orchid1")) |
| 12801 | (t (:italic t :bold t))) |
| 12802 | "Font lock mode face used to highlight standardized functions and packages." |
| 12803 | :group 'vhdl-highlight-faces) |
| 12804 | |
| 12805 | (defface vhdl-font-lock-directive-face |
| 12806 | '((((class color) (background light)) (:foreground "CadetBlue")) |
| 12807 | (((class color) (background dark)) (:foreground "Aquamarine")) |
| 12808 | (t (:italic t :bold t))) |
| 12809 | "Font lock mode face used to highlight directives." |
| 12810 | :group 'vhdl-highlight-faces) |
| 12811 | |
| 12812 | (defface vhdl-font-lock-reserved-words-face |
| 12813 | '((((class color) (background light)) (:foreground "Orange" :bold t)) |
| 12814 | (((min-colors 88) (class color) (background dark)) |
| 12815 | (:foreground "Yellow1" :bold t)) |
| 12816 | (((class color) (background dark)) (:foreground "Yellow" :bold t)) |
| 12817 | (t ())) |
| 12818 | "Font lock mode face used to highlight additional reserved words." |
| 12819 | :group 'vhdl-highlight-faces) |
| 12820 | |
| 12821 | (defface vhdl-font-lock-translate-off-face |
| 12822 | '((((class color) (background light)) (:background "LightGray")) |
| 12823 | (((class color) (background dark)) (:background "DimGray")) |
| 12824 | (t ())) |
| 12825 | "Font lock mode face used to background highlight translate-off regions." |
| 12826 | :group 'vhdl-highlight-faces) |
| 12827 | |
| 12828 | ;; font lock mode faces used to highlight words with special syntax. |
| 12829 | (let ((syntax-alist vhdl-special-syntax-alist)) |
| 12830 | (while syntax-alist |
| 12831 | (eval `(defface ,(vhdl-function-name |
| 12832 | "vhdl-font-lock" (caar syntax-alist) "face") |
| 12833 | '((((class color) (background light)) |
| 12834 | (:foreground ,(nth 2 (car syntax-alist)))) |
| 12835 | (((class color) (background dark)) |
| 12836 | (:foreground ,(nth 3 (car syntax-alist)))) |
| 12837 | (t ())) |
| 12838 | ,(concat "Font lock mode face used to highlight " |
| 12839 | (nth 0 (car syntax-alist)) ".") |
| 12840 | :group 'vhdl-highlight-faces)) |
| 12841 | (setq syntax-alist (cdr syntax-alist)))) |
| 12842 | |
| 12843 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12844 | ;; Font lock initialization |
| 12845 | |
| 12846 | (defun vhdl-font-lock-init () |
| 12847 | "Initialize fontification." |
| 12848 | ;; highlight template prompts and directives |
| 12849 | (setq vhdl-font-lock-keywords-0 |
| 12850 | (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" |
| 12851 | vhdl-template-prompt-syntax ">\\)") |
| 12852 | 2 'vhdl-font-lock-prompt-face t) |
| 12853 | (list (concat "--\\s-*" |
| 12854 | vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") |
| 12855 | 2 'vhdl-font-lock-directive-face t) |
| 12856 | ;; highlight c-preprocessor directives |
| 12857 | (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" |
| 12858 | '(1 font-lock-builtin-face) |
| 12859 | '(3 font-lock-variable-name-face nil t)))) |
| 12860 | ;; highlight keywords and standardized types, attributes, enumeration |
| 12861 | ;; values, and subprograms |
| 12862 | (setq vhdl-font-lock-keywords-1 |
| 12863 | (list |
| 12864 | (list (concat "'" vhdl-attributes-regexp) |
| 12865 | 1 'vhdl-font-lock-attribute-face) |
| 12866 | (list vhdl-types-regexp 1 'font-lock-type-face) |
| 12867 | (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) |
| 12868 | (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) |
| 12869 | (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) |
| 12870 | (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) |
| 12871 | ;; highlight words with special syntax. |
| 12872 | (setq vhdl-font-lock-keywords-3 |
| 12873 | (let ((syntax-alist vhdl-special-syntax-alist) |
| 12874 | keywords) |
| 12875 | (while syntax-alist |
| 12876 | (setq keywords |
| 12877 | (cons |
| 12878 | (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>") |
| 12879 | (vhdl-function-name |
| 12880 | "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) |
| 12881 | keywords)) |
| 12882 | (setq syntax-alist (cdr syntax-alist))) |
| 12883 | keywords)) |
| 12884 | ;; highlight additional reserved words |
| 12885 | (setq vhdl-font-lock-keywords-4 |
| 12886 | (list (list vhdl-reserved-words-regexp 1 |
| 12887 | 'vhdl-font-lock-reserved-words-face))) |
| 12888 | ;; highlight everything together |
| 12889 | (setq vhdl-font-lock-keywords |
| 12890 | (append |
| 12891 | vhdl-font-lock-keywords-0 |
| 12892 | (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) |
| 12893 | (when (or vhdl-highlight-forbidden-words |
| 12894 | vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) |
| 12895 | (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) |
| 12896 | (when vhdl-highlight-names vhdl-font-lock-keywords-2) |
| 12897 | (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) |
| 12898 | |
| 12899 | ;; initialize fontification for VHDL Mode |
| 12900 | (vhdl-font-lock-init) |
| 12901 | |
| 12902 | (defun vhdl-fontify-buffer () |
| 12903 | "Re-initialize fontification and fontify buffer." |
| 12904 | (interactive) |
| 12905 | (setq font-lock-defaults |
| 12906 | `(vhdl-font-lock-keywords |
| 12907 | nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) |
| 12908 | beginning-of-line)) |
| 12909 | (when (fboundp 'font-lock-unset-defaults) |
| 12910 | (font-lock-unset-defaults)) ; not implemented in XEmacs |
| 12911 | (font-lock-set-defaults) |
| 12912 | (font-lock-mode nil) |
| 12913 | (font-lock-mode t)) |
| 12914 | |
| 12915 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12916 | ;; Initialization for PostScript printing |
| 12917 | |
| 12918 | (defun vhdl-ps-print-settings () |
| 12919 | "Initialize custom face and page settings for PostScript printing." |
| 12920 | ;; define custom face settings |
| 12921 | (unless (or (not vhdl-print-customize-faces) |
| 12922 | ps-print-color-p) |
| 12923 | (set (make-local-variable 'ps-bold-faces) |
| 12924 | '(font-lock-keyword-face |
| 12925 | font-lock-type-face |
| 12926 | vhdl-font-lock-attribute-face |
| 12927 | vhdl-font-lock-enumvalue-face |
| 12928 | vhdl-font-lock-directive-face)) |
| 12929 | (set (make-local-variable 'ps-italic-faces) |
| 12930 | '(font-lock-comment-face |
| 12931 | font-lock-function-name-face |
| 12932 | font-lock-type-face |
| 12933 | vhdl-font-lock-attribute-face |
| 12934 | vhdl-font-lock-enumvalue-face |
| 12935 | vhdl-font-lock-directive-face)) |
| 12936 | (set (make-local-variable 'ps-underlined-faces) |
| 12937 | '(font-lock-string-face)) |
| 12938 | (setq ps-always-build-face-reference t)) |
| 12939 | ;; define page settings, so that a line containing 79 characters (default) |
| 12940 | ;; fits into one column |
| 12941 | (when vhdl-print-two-column |
| 12942 | (set (make-local-variable 'ps-landscape-mode) t) |
| 12943 | (set (make-local-variable 'ps-number-of-columns) 2) |
| 12944 | (set (make-local-variable 'ps-font-size) 7.0) |
| 12945 | (set (make-local-variable 'ps-header-title-font-size) 10.0) |
| 12946 | (set (make-local-variable 'ps-header-font-size) 9.0) |
| 12947 | (set (make-local-variable 'ps-header-offset) 12.0) |
| 12948 | (when (eq ps-paper-type 'letter) |
| 12949 | (set (make-local-variable 'ps-inter-column) 40.0) |
| 12950 | (set (make-local-variable 'ps-left-margin) 40.0) |
| 12951 | (set (make-local-variable 'ps-right-margin) 40.0)))) |
| 12952 | |
| 12953 | (defun vhdl-ps-print-init () |
| 12954 | "Initialize PostScript printing." |
| 12955 | (if (featurep 'xemacs) |
| 12956 | (when (boundp 'ps-print-color-p) |
| 12957 | (vhdl-ps-print-settings)) |
| 12958 | (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) |
| 12959 | (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) |
| 12960 | |
| 12961 | |
| 12962 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12963 | ;;; Hierarchy browser (using `speedbar.el') |
| 12964 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12965 | ;; Allows displaying the hierarchy of all VHDL design units contained in a |
| 12966 | ;; directory by using the speedbar. |
| 12967 | |
| 12968 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12969 | ;; Variables |
| 12970 | |
| 12971 | (defvar vhdl-entity-alist nil |
| 12972 | "Cache with entities and corresponding architectures for each |
| 12973 | project/directory.") |
| 12974 | ;; structure: (parenthesized expression means list of such entries) |
| 12975 | ;; (cache-key |
| 12976 | ;; (ent-key ent-name ent-file ent-line |
| 12977 | ;; (arch-key arch-name arch-file arch-line |
| 12978 | ;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key |
| 12979 | ;; inst-arch-key inst-conf-key inst-lib-key inst-path) |
| 12980 | ;; (lib-name pack-key)) |
| 12981 | ;; mra-key (lib-name pack-key)) |
| 12982 | |
| 12983 | (defvar vhdl-config-alist nil |
| 12984 | "Cache with configurations for each project/directory.") |
| 12985 | ;; structure: (parenthesized expression means list of such entries) |
| 12986 | ;; (cache-key |
| 12987 | ;; (conf-key conf-name conf-file conf-line ent-key arch-key |
| 12988 | ;; (inst-key inst-comp-name inst-ent-key inst-arch-key |
| 12989 | ;; inst-conf-key inst-lib-key) |
| 12990 | ;; (lib-name pack-key))) |
| 12991 | |
| 12992 | (defvar vhdl-package-alist nil |
| 12993 | "Cache with packages for each project/directory.") |
| 12994 | ;; structure: (parenthesized expression means list of such entries) |
| 12995 | ;; (cache-key |
| 12996 | ;; (pack-key pack-name pack-file pack-line |
| 12997 | ;; (comp-key comp-name comp-file comp-line) |
| 12998 | ;; (func-key func-name func-file func-line) |
| 12999 | ;; (lib-name pack-key) |
| 13000 | ;; pack-body-file pack-body-line |
| 13001 | ;; (func-key func-name func-body-file func-body-line) |
| 13002 | ;; (lib-name pack-key))) |
| 13003 | |
| 13004 | (defvar vhdl-ent-inst-alist nil |
| 13005 | "Cache with instantiated entities for each project/directory.") |
| 13006 | ;; structure: (parenthesized expression means list of such entries) |
| 13007 | ;; (cache-key (inst-ent-key)) |
| 13008 | |
| 13009 | (defvar vhdl-file-alist nil |
| 13010 | "Cache with design units in each file for each project/directory.") |
| 13011 | ;; structure: (parenthesized expression means list of such entries) |
| 13012 | ;; (cache-key |
| 13013 | ;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) |
| 13014 | ;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) |
| 13015 | |
| 13016 | (defvar vhdl-directory-alist nil |
| 13017 | "Cache with source directories for each project.") |
| 13018 | ;; structure: (parenthesized expression means list of such entries) |
| 13019 | ;; (cache-key (directory)) |
| 13020 | |
| 13021 | (defvar vhdl-speedbar-shown-unit-alist nil |
| 13022 | "Alist of design units simultaneously open in the current speedbar for each |
| 13023 | directory and project.") |
| 13024 | |
| 13025 | (defvar vhdl-speedbar-shown-project-list nil |
| 13026 | "List of projects simultaneously open in the current speedbar.") |
| 13027 | |
| 13028 | (defvar vhdl-updated-project-list nil |
| 13029 | "List of projects and directories with updated files.") |
| 13030 | |
| 13031 | (defvar vhdl-modified-file-list nil |
| 13032 | "List of modified files to be rescanned for hierarchy updating.") |
| 13033 | |
| 13034 | (defvar vhdl-speedbar-hierarchy-depth 0 |
| 13035 | "Depth of instantiation hierarchy to display.") |
| 13036 | |
| 13037 | (defvar vhdl-speedbar-show-projects nil |
| 13038 | "Non-nil means project hierarchy is displayed in speedbar, directory |
| 13039 | hierarchy otherwise.") |
| 13040 | |
| 13041 | (defun vhdl-get-end-of-unit () |
| 13042 | "Return position of end of current unit." |
| 13043 | (let ((pos (point))) |
| 13044 | (save-excursion |
| 13045 | (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1) |
| 13046 | (save-excursion |
| 13047 | (goto-char (match-beginning 0)) |
| 13048 | (vhdl-backward-syntactic-ws) |
| 13049 | (and (/= (preceding-char) ?\;) (not (bobp)))))) |
| 13050 | (re-search-backward "^[ \t]*end\\>" pos 1) |
| 13051 | (point)))) |
| 13052 | |
| 13053 | (defun vhdl-match-string-downcase (num &optional string) |
| 13054 | "Like `match-string-no-properties' with down-casing." |
| 13055 | (let ((match (match-string-no-properties num string))) |
| 13056 | (and match (downcase match)))) |
| 13057 | |
| 13058 | |
| 13059 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13060 | ;; Scan functions |
| 13061 | |
| 13062 | (defun vhdl-scan-context-clause () |
| 13063 | "Scan the context clause that precedes a design unit." |
| 13064 | (let (lib-alist) |
| 13065 | (save-excursion |
| 13066 | (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t) |
| 13067 | (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) |
| 13068 | (equal "USE" (upcase (match-string 1)))) |
| 13069 | (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") |
| 13070 | (setq lib-alist (cons (cons (match-string-no-properties 1) |
| 13071 | (vhdl-match-string-downcase 2)) |
| 13072 | lib-alist)))))) |
| 13073 | lib-alist)) |
| 13074 | |
| 13075 | (defun vhdl-scan-directory-contents (name &optional project update num-string |
| 13076 | non-final) |
| 13077 | "Scan contents of VHDL files in directory or file pattern NAME." |
| 13078 | (string-match "\\(.*[/\\]\\)\\(.*\\)" name) |
| 13079 | ; (unless (file-directory-p (match-string 1 name)) |
| 13080 | ; (message "No such directory: \"%s\"" (match-string 1 name))) |
| 13081 | (let* ((dir-name (match-string 1 name)) |
| 13082 | (file-pattern (match-string 2 name)) |
| 13083 | (is-directory (= 0 (length file-pattern))) |
| 13084 | (file-list |
| 13085 | (if update |
| 13086 | (list name) |
| 13087 | (if is-directory |
| 13088 | (vhdl-get-source-files t dir-name) |
| 13089 | (vhdl-directory-files |
| 13090 | dir-name t (wildcard-to-regexp file-pattern))))) |
| 13091 | (key (or project dir-name)) |
| 13092 | (file-exclude-regexp |
| 13093 | (or (nth 3 (aget vhdl-project-alist project)) "")) |
| 13094 | (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) |
| 13095 | (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) |
| 13096 | (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) |
| 13097 | ent-alist conf-alist pack-alist ent-inst-list file-alist |
| 13098 | tmp-list tmp-entry no-files files-exist big-files) |
| 13099 | (when (or project update) |
| 13100 | (setq ent-alist (aget vhdl-entity-alist key t) |
| 13101 | conf-alist (aget vhdl-config-alist key t) |
| 13102 | pack-alist (aget vhdl-package-alist key t) |
| 13103 | ent-inst-list (car (aget vhdl-ent-inst-alist key t)) |
| 13104 | file-alist (aget vhdl-file-alist key t))) |
| 13105 | (when (and (not is-directory) (null file-list)) |
| 13106 | (message "No such file: \"%s\"" name)) |
| 13107 | (setq files-exist file-list) |
| 13108 | (when file-list |
| 13109 | (setq no-files (length file-list)) |
| 13110 | (message "Scanning %s %s\"%s\"..." |
| 13111 | (if is-directory "directory" "files") (or num-string "") name) |
| 13112 | ;; exclude files |
| 13113 | (unless (equal file-exclude-regexp "") |
| 13114 | (let ((case-fold-search nil) |
| 13115 | file-tmp-list) |
| 13116 | (while file-list |
| 13117 | (unless (string-match file-exclude-regexp (car file-list)) |
| 13118 | (setq file-tmp-list (cons (car file-list) file-tmp-list))) |
| 13119 | (setq file-list (cdr file-list))) |
| 13120 | (setq file-list (nreverse file-tmp-list)))) |
| 13121 | ;; do for all files |
| 13122 | (while file-list |
| 13123 | (unless noninteractive |
| 13124 | (message "Scanning %s %s\"%s\"... (%2d%s)" |
| 13125 | (if is-directory "directory" "files") |
| 13126 | (or num-string "") name |
| 13127 | (/ (* 100 (- no-files (length file-list))) no-files) "%")) |
| 13128 | (let ((file-name (abbreviate-file-name (car file-list))) |
| 13129 | ent-list arch-list arch-ent-list conf-list |
| 13130 | pack-list pack-body-list inst-list inst-ent-list) |
| 13131 | ;; scan file |
| 13132 | (vhdl-visit-file |
| 13133 | file-name nil |
| 13134 | (vhdl-prepare-search-2 |
| 13135 | (save-excursion |
| 13136 | ;; scan for design units |
| 13137 | (if (and limit-design-file-size |
| 13138 | (< limit-design-file-size (buffer-size))) |
| 13139 | (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) |
| 13140 | (setq big-files t)) |
| 13141 | ;; scan for entities |
| 13142 | (goto-char (point-min)) |
| 13143 | (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 13144 | (let* ((ent-name (match-string-no-properties 1)) |
| 13145 | (ent-key (downcase ent-name)) |
| 13146 | (ent-entry (aget ent-alist ent-key t)) |
| 13147 | (lib-alist (vhdl-scan-context-clause))) |
| 13148 | (if (nth 1 ent-entry) |
| 13149 | (vhdl-warning-when-idle |
| 13150 | "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13151 | ent-name (nth 1 ent-entry) (nth 2 ent-entry) |
| 13152 | file-name (vhdl-current-line)) |
| 13153 | (setq ent-list (cons ent-key ent-list)) |
| 13154 | (aput 'ent-alist ent-key |
| 13155 | (list ent-name file-name (vhdl-current-line) |
| 13156 | (nth 3 ent-entry) (nth 4 ent-entry) |
| 13157 | lib-alist))))) |
| 13158 | ;; scan for architectures |
| 13159 | (goto-char (point-min)) |
| 13160 | (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 13161 | (let* ((arch-name (match-string-no-properties 1)) |
| 13162 | (arch-key (downcase arch-name)) |
| 13163 | (ent-name (match-string-no-properties 2)) |
| 13164 | (ent-key (downcase ent-name)) |
| 13165 | (ent-entry (aget ent-alist ent-key t)) |
| 13166 | (arch-alist (nth 3 ent-entry)) |
| 13167 | (arch-entry (aget arch-alist arch-key t)) |
| 13168 | (lib-arch-alist (vhdl-scan-context-clause))) |
| 13169 | (if arch-entry |
| 13170 | (vhdl-warning-when-idle |
| 13171 | "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13172 | arch-name ent-name (nth 1 arch-entry) |
| 13173 | (nth 2 arch-entry) file-name (vhdl-current-line)) |
| 13174 | (setq arch-list (cons arch-key arch-list) |
| 13175 | arch-ent-list (cons ent-key arch-ent-list)) |
| 13176 | (aput 'arch-alist arch-key |
| 13177 | (list arch-name file-name (vhdl-current-line) nil |
| 13178 | lib-arch-alist)) |
| 13179 | (aput 'ent-alist ent-key |
| 13180 | (list (or (nth 0 ent-entry) ent-name) |
| 13181 | (nth 1 ent-entry) (nth 2 ent-entry) |
| 13182 | (vhdl-sort-alist arch-alist) |
| 13183 | arch-key (nth 5 ent-entry)))))) |
| 13184 | ;; scan for configurations |
| 13185 | (goto-char (point-min)) |
| 13186 | (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 13187 | (let* ((conf-name (match-string-no-properties 1)) |
| 13188 | (conf-key (downcase conf-name)) |
| 13189 | (conf-entry (aget conf-alist conf-key t)) |
| 13190 | (ent-name (match-string-no-properties 2)) |
| 13191 | (ent-key (downcase ent-name)) |
| 13192 | (lib-alist (vhdl-scan-context-clause)) |
| 13193 | (conf-line (vhdl-current-line)) |
| 13194 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13195 | arch-key comp-conf-list inst-key-list |
| 13196 | inst-comp-key inst-ent-key inst-arch-key |
| 13197 | inst-conf-key inst-lib-key) |
| 13198 | (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)") |
| 13199 | (setq arch-key (vhdl-match-string-downcase 1))) |
| 13200 | (if conf-entry |
| 13201 | (vhdl-warning-when-idle |
| 13202 | "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13203 | conf-name ent-name (nth 1 conf-entry) |
| 13204 | (nth 2 conf-entry) file-name conf-line) |
| 13205 | (setq conf-list (cons conf-key conf-list)) |
| 13206 | ;; scan for subconfigurations and subentities |
| 13207 | (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t) |
| 13208 | (setq inst-comp-key (vhdl-match-string-downcase 3) |
| 13209 | inst-key-list (split-string |
| 13210 | (vhdl-match-string-downcase 1) |
| 13211 | "[ \t\n]*,[ \t\n]*")) |
| 13212 | (vhdl-forward-syntactic-ws) |
| 13213 | (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?") |
| 13214 | (setq |
| 13215 | inst-lib-key (vhdl-match-string-downcase 3) |
| 13216 | inst-ent-key (and (match-string 2) |
| 13217 | (vhdl-match-string-downcase 4)) |
| 13218 | inst-arch-key (and (match-string 2) |
| 13219 | (vhdl-match-string-downcase 6)) |
| 13220 | inst-conf-key (and (not (match-string 2)) |
| 13221 | (vhdl-match-string-downcase 4))) |
| 13222 | (while inst-key-list |
| 13223 | (setq comp-conf-list |
| 13224 | (cons (list (car inst-key-list) |
| 13225 | inst-comp-key inst-ent-key |
| 13226 | inst-arch-key inst-conf-key |
| 13227 | inst-lib-key) |
| 13228 | comp-conf-list)) |
| 13229 | (setq inst-key-list (cdr inst-key-list))))) |
| 13230 | (aput 'conf-alist conf-key |
| 13231 | (list conf-name file-name conf-line ent-key |
| 13232 | arch-key comp-conf-list lib-alist))))) |
| 13233 | ;; scan for packages |
| 13234 | (goto-char (point-min)) |
| 13235 | (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 13236 | (let* ((pack-name (match-string-no-properties 2)) |
| 13237 | (pack-key (downcase pack-name)) |
| 13238 | (is-body (match-string-no-properties 1)) |
| 13239 | (pack-entry (aget pack-alist pack-key t)) |
| 13240 | (pack-line (vhdl-current-line)) |
| 13241 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13242 | comp-name func-name comp-alist func-alist lib-alist) |
| 13243 | (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) |
| 13244 | (vhdl-warning-when-idle |
| 13245 | "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13246 | (if is-body " body" "") pack-name |
| 13247 | (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) |
| 13248 | (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) |
| 13249 | file-name (vhdl-current-line)) |
| 13250 | ;; scan for context clauses |
| 13251 | (setq lib-alist (vhdl-scan-context-clause)) |
| 13252 | ;; scan for component and subprogram declarations/bodies |
| 13253 | (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t) |
| 13254 | (if (equal (upcase (match-string 1)) "COMPONENT") |
| 13255 | (setq comp-name (match-string-no-properties 2) |
| 13256 | comp-alist |
| 13257 | (cons (list (downcase comp-name) comp-name |
| 13258 | file-name (vhdl-current-line)) |
| 13259 | comp-alist)) |
| 13260 | (setq func-name (match-string-no-properties 2) |
| 13261 | func-alist |
| 13262 | (cons (list (downcase func-name) func-name |
| 13263 | file-name (vhdl-current-line)) |
| 13264 | func-alist)))) |
| 13265 | (setq func-alist (nreverse func-alist)) |
| 13266 | (setq comp-alist (nreverse comp-alist)) |
| 13267 | (if is-body |
| 13268 | (setq pack-body-list (cons pack-key pack-body-list)) |
| 13269 | (setq pack-list (cons pack-key pack-list))) |
| 13270 | (aput |
| 13271 | 'pack-alist pack-key |
| 13272 | (if is-body |
| 13273 | (list (or (nth 0 pack-entry) pack-name) |
| 13274 | (nth 1 pack-entry) (nth 2 pack-entry) |
| 13275 | (nth 3 pack-entry) (nth 4 pack-entry) |
| 13276 | (nth 5 pack-entry) |
| 13277 | file-name pack-line func-alist lib-alist) |
| 13278 | (list pack-name file-name pack-line |
| 13279 | comp-alist func-alist lib-alist |
| 13280 | (nth 6 pack-entry) (nth 7 pack-entry) |
| 13281 | (nth 8 pack-entry) (nth 9 pack-entry)))))))) |
| 13282 | ;; scan for hierarchy |
| 13283 | (if (and limit-hier-file-size |
| 13284 | (< limit-hier-file-size (buffer-size))) |
| 13285 | (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) |
| 13286 | (setq big-files t)) |
| 13287 | ;; scan for architectures |
| 13288 | (goto-char (point-min)) |
| 13289 | (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 13290 | (let* ((ent-name (match-string-no-properties 2)) |
| 13291 | (ent-key (downcase ent-name)) |
| 13292 | (arch-name (match-string-no-properties 1)) |
| 13293 | (arch-key (downcase arch-name)) |
| 13294 | (ent-entry (aget ent-alist ent-key t)) |
| 13295 | (arch-alist (nth 3 ent-entry)) |
| 13296 | (arch-entry (aget arch-alist arch-key t)) |
| 13297 | (beg-of-unit (point)) |
| 13298 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13299 | (inst-no 0) |
| 13300 | inst-alist inst-path) |
| 13301 | ;; scan for contained instantiations |
| 13302 | (while (and (re-search-forward |
| 13303 | (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\(" |
| 13304 | "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|" |
| 13305 | "component[ \t\n]+\\(\\w+\\)\\|" |
| 13306 | "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\|" |
| 13307 | "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" |
| 13308 | "\\(^[ \t]*end[ \t\n]+\\(generate\\|block\\)\\>\\)") end-of-unit t) |
| 13309 | (or (not limit-hier-inst-no) |
| 13310 | (<= (setq inst-no (1+ inst-no)) |
| 13311 | limit-hier-inst-no))) |
| 13312 | (cond |
| 13313 | ;; block/generate beginning found |
| 13314 | ((match-string 14) |
| 13315 | (setq inst-path |
| 13316 | (cons (match-string-no-properties 1) inst-path))) |
| 13317 | ;; block/generate end found |
| 13318 | ((match-string 16) |
| 13319 | (setq inst-path (cdr inst-path))) |
| 13320 | ;; instantiation found |
| 13321 | (t |
| 13322 | (let* ((inst-name (match-string-no-properties 1)) |
| 13323 | (inst-key (downcase inst-name)) |
| 13324 | (inst-comp-name |
| 13325 | (or (match-string-no-properties 3) |
| 13326 | (match-string-no-properties 6))) |
| 13327 | (inst-ent-key |
| 13328 | (or (and (match-string 8) |
| 13329 | (vhdl-match-string-downcase 11)) |
| 13330 | (and inst-comp-name |
| 13331 | (downcase inst-comp-name)))) |
| 13332 | (inst-arch-key (vhdl-match-string-downcase 13)) |
| 13333 | (inst-conf-key |
| 13334 | (and (not (match-string 8)) |
| 13335 | (vhdl-match-string-downcase 11))) |
| 13336 | (inst-lib-key (vhdl-match-string-downcase 10))) |
| 13337 | (goto-char (match-end 1)) |
| 13338 | (setq inst-list (cons inst-key inst-list) |
| 13339 | inst-ent-list |
| 13340 | (cons inst-ent-key inst-ent-list)) |
| 13341 | (setq inst-alist |
| 13342 | (append |
| 13343 | inst-alist |
| 13344 | (list (list inst-key inst-name file-name |
| 13345 | (vhdl-current-line) inst-comp-name |
| 13346 | inst-ent-key inst-arch-key |
| 13347 | inst-conf-key inst-lib-key |
| 13348 | (reverse inst-path))))))))) |
| 13349 | ;; scan for contained configuration specifications |
| 13350 | (goto-char beg-of-unit) |
| 13351 | (while (re-search-forward |
| 13352 | (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*" |
| 13353 | "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t) |
| 13354 | (let* ((inst-comp-name (match-string-no-properties 3)) |
| 13355 | (inst-ent-key |
| 13356 | (and (match-string 6) |
| 13357 | (vhdl-match-string-downcase 9))) |
| 13358 | (inst-arch-key (vhdl-match-string-downcase 11)) |
| 13359 | (inst-conf-key |
| 13360 | (and (not (match-string 6)) |
| 13361 | (vhdl-match-string-downcase 9))) |
| 13362 | (inst-lib-key (vhdl-match-string-downcase 8)) |
| 13363 | (inst-key-list |
| 13364 | (split-string (vhdl-match-string-downcase 1) |
| 13365 | "[ \t\n]*,[ \t\n]*")) |
| 13366 | (tmp-inst-alist inst-alist) |
| 13367 | inst-entry) |
| 13368 | (while tmp-inst-alist |
| 13369 | (when (and (or (equal "all" (car inst-key-list)) |
| 13370 | (member (nth 0 (car tmp-inst-alist)) |
| 13371 | inst-key-list)) |
| 13372 | (equal |
| 13373 | (downcase |
| 13374 | (or (nth 4 (car tmp-inst-alist)) "")) |
| 13375 | (downcase inst-comp-name))) |
| 13376 | (setq inst-entry (car tmp-inst-alist)) |
| 13377 | (setq inst-ent-list |
| 13378 | (cons (or inst-ent-key (nth 5 inst-entry)) |
| 13379 | (vhdl-delete |
| 13380 | (nth 5 inst-entry) inst-ent-list))) |
| 13381 | (setq inst-entry |
| 13382 | (list (nth 0 inst-entry) (nth 1 inst-entry) |
| 13383 | (nth 2 inst-entry) (nth 3 inst-entry) |
| 13384 | (nth 4 inst-entry) |
| 13385 | (or inst-ent-key (nth 5 inst-entry)) |
| 13386 | (or inst-arch-key (nth 6 inst-entry)) |
| 13387 | inst-conf-key inst-lib-key)) |
| 13388 | (setcar tmp-inst-alist inst-entry)) |
| 13389 | (setq tmp-inst-alist (cdr tmp-inst-alist))))) |
| 13390 | ;; save in cache |
| 13391 | (aput 'arch-alist arch-key |
| 13392 | (list (nth 0 arch-entry) (nth 1 arch-entry) |
| 13393 | (nth 2 arch-entry) inst-alist |
| 13394 | (nth 4 arch-entry))) |
| 13395 | (aput 'ent-alist ent-key |
| 13396 | (list (nth 0 ent-entry) (nth 1 ent-entry) |
| 13397 | (nth 2 ent-entry) (vhdl-sort-alist arch-alist) |
| 13398 | (nth 4 ent-entry) (nth 5 ent-entry))) |
| 13399 | (when (and limit-hier-inst-no |
| 13400 | (> inst-no limit-hier-inst-no)) |
| 13401 | (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) |
| 13402 | (setq big-files t)) |
| 13403 | (goto-char end-of-unit)))) |
| 13404 | ;; remember design units for this file |
| 13405 | (aput 'file-alist file-name |
| 13406 | (list ent-list arch-list arch-ent-list conf-list |
| 13407 | pack-list pack-body-list inst-list inst-ent-list)) |
| 13408 | (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) |
| 13409 | (setq file-list (cdr file-list)))) |
| 13410 | (when (or (and (not project) files-exist) |
| 13411 | (and project (not non-final))) |
| 13412 | ;; consistency checks: |
| 13413 | ;; check whether each architecture has a corresponding entity |
| 13414 | (setq tmp-list ent-alist) |
| 13415 | (while tmp-list |
| 13416 | (when (null (nth 2 (car tmp-list))) |
| 13417 | (setq tmp-entry (car (nth 4 (car tmp-list)))) |
| 13418 | (vhdl-warning-when-idle |
| 13419 | "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" |
| 13420 | (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) |
| 13421 | (nth 3 tmp-entry))) |
| 13422 | (setq tmp-list (cdr tmp-list))) |
| 13423 | ;; check whether configuration has a corresponding entity/architecture |
| 13424 | (setq tmp-list conf-alist) |
| 13425 | (while tmp-list |
| 13426 | (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t)) |
| 13427 | (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) |
| 13428 | (setq tmp-entry (car tmp-list)) |
| 13429 | (vhdl-warning-when-idle |
| 13430 | "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" |
| 13431 | (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) |
| 13432 | (nth 2 tmp-entry) (nth 3 tmp-entry))) |
| 13433 | (setq tmp-entry (car tmp-list)) |
| 13434 | (vhdl-warning-when-idle |
| 13435 | "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" |
| 13436 | (nth 1 tmp-entry) (nth 4 tmp-entry) |
| 13437 | (nth 2 tmp-entry) (nth 3 tmp-entry))) |
| 13438 | (setq tmp-list (cdr tmp-list))) |
| 13439 | ;; check whether each package body has a package declaration |
| 13440 | (setq tmp-list pack-alist) |
| 13441 | (while tmp-list |
| 13442 | (when (null (nth 2 (car tmp-list))) |
| 13443 | (setq tmp-entry (car tmp-list)) |
| 13444 | (vhdl-warning-when-idle |
| 13445 | "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" |
| 13446 | (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) |
| 13447 | (setq tmp-list (cdr tmp-list))) |
| 13448 | ;; sort lists |
| 13449 | (setq ent-alist (vhdl-sort-alist ent-alist)) |
| 13450 | (setq conf-alist (vhdl-sort-alist conf-alist)) |
| 13451 | (setq pack-alist (vhdl-sort-alist pack-alist)) |
| 13452 | ;; remember updated directory/project |
| 13453 | (add-to-list 'vhdl-updated-project-list (or project dir-name))) |
| 13454 | ;; clear directory alists |
| 13455 | (unless project |
| 13456 | (adelete 'vhdl-entity-alist key) |
| 13457 | (adelete 'vhdl-config-alist key) |
| 13458 | (adelete 'vhdl-package-alist key) |
| 13459 | (adelete 'vhdl-ent-inst-alist key) |
| 13460 | (adelete 'vhdl-file-alist key)) |
| 13461 | ;; put directory contents into cache |
| 13462 | (aput 'vhdl-entity-alist key ent-alist) |
| 13463 | (aput 'vhdl-config-alist key conf-alist) |
| 13464 | (aput 'vhdl-package-alist key pack-alist) |
| 13465 | (aput 'vhdl-ent-inst-alist key (list ent-inst-list)) |
| 13466 | (aput 'vhdl-file-alist key file-alist) |
| 13467 | ;; final messages |
| 13468 | (message "Scanning %s %s\"%s\"...done" |
| 13469 | (if is-directory "directory" "files") (or num-string "") name) |
| 13470 | (unless project (message "Scanning directory...done")) |
| 13471 | (when big-files |
| 13472 | (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) |
| 13473 | ;; save cache when scanned non-interactively |
| 13474 | (when (or (not project) (not non-final)) |
| 13475 | (when (and noninteractive vhdl-speedbar-save-cache) |
| 13476 | (vhdl-save-cache key))) |
| 13477 | t)) |
| 13478 | |
| 13479 | (defun vhdl-scan-project-contents (project) |
| 13480 | "Scan the contents of all VHDL files found in the directories and files |
| 13481 | of PROJECT." |
| 13482 | (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '(""))) |
| 13483 | (default-dir (vhdl-resolve-env-variable |
| 13484 | (nth 1 (aget vhdl-project-alist project)))) |
| 13485 | (file-exclude-regexp |
| 13486 | (or (nth 3 (aget vhdl-project-alist project)) "")) |
| 13487 | dir-list-tmp dir dir-name num-dir act-dir recursive) |
| 13488 | ;; clear project alists |
| 13489 | (adelete 'vhdl-entity-alist project) |
| 13490 | (adelete 'vhdl-config-alist project) |
| 13491 | (adelete 'vhdl-package-alist project) |
| 13492 | (adelete 'vhdl-ent-inst-alist project) |
| 13493 | (adelete 'vhdl-file-alist project) |
| 13494 | ;; expand directory names by default-directory |
| 13495 | (message "Collecting source files...") |
| 13496 | (while dir-list |
| 13497 | (setq dir (vhdl-resolve-env-variable (car dir-list))) |
| 13498 | (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) |
| 13499 | (setq recursive (match-string 1 dir) |
| 13500 | dir-name (match-string 3 dir)) |
| 13501 | (setq dir-list-tmp |
| 13502 | (cons (concat recursive |
| 13503 | (if (file-name-absolute-p dir-name) "" default-dir) |
| 13504 | dir-name) |
| 13505 | dir-list-tmp)) |
| 13506 | (setq dir-list (cdr dir-list))) |
| 13507 | ;; resolve path wildcards |
| 13508 | (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) |
| 13509 | ;; expand directories |
| 13510 | (while dir-list-tmp |
| 13511 | (setq dir (car dir-list-tmp)) |
| 13512 | ;; get subdirectories |
| 13513 | (if (string-match "-r \\(.*[/\\]\\)" dir) |
| 13514 | (setq dir-list (append dir-list (vhdl-get-subdirs |
| 13515 | (match-string 1 dir)))) |
| 13516 | (setq dir-list (append dir-list (list dir)))) |
| 13517 | (setq dir-list-tmp (cdr dir-list-tmp))) |
| 13518 | ;; exclude files |
| 13519 | (unless (equal file-exclude-regexp "") |
| 13520 | (let ((case-fold-search nil)) |
| 13521 | (while dir-list |
| 13522 | (unless (string-match file-exclude-regexp (car dir-list)) |
| 13523 | (setq dir-list-tmp (cons (car dir-list) dir-list-tmp))) |
| 13524 | (setq dir-list (cdr dir-list))) |
| 13525 | (setq dir-list (nreverse dir-list-tmp)))) |
| 13526 | (message "Collecting source files...done") |
| 13527 | ;; scan for design units for each directory in DIR-LIST |
| 13528 | (setq dir-list-tmp nil |
| 13529 | num-dir (length dir-list) |
| 13530 | act-dir 1) |
| 13531 | (while dir-list |
| 13532 | (setq dir-name (abbreviate-file-name |
| 13533 | (expand-file-name (car dir-list)))) |
| 13534 | (vhdl-scan-directory-contents dir-name project nil |
| 13535 | (format "(%s/%s) " act-dir num-dir) |
| 13536 | (cdr dir-list)) |
| 13537 | (add-to-list 'dir-list-tmp (file-name-directory dir-name)) |
| 13538 | (setq dir-list (cdr dir-list) |
| 13539 | act-dir (1+ act-dir))) |
| 13540 | (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) |
| 13541 | (message "Scanning project \"%s\"...done" project))) |
| 13542 | |
| 13543 | (defun vhdl-update-file-contents (file-name) |
| 13544 | "Update hierarchy information by contents of current buffer." |
| 13545 | (setq file-name (abbreviate-file-name file-name)) |
| 13546 | (let* ((dir-name (file-name-directory file-name)) |
| 13547 | (directory-alist vhdl-directory-alist) |
| 13548 | updated) |
| 13549 | (while directory-alist |
| 13550 | (when (member dir-name (nth 1 (car directory-alist))) |
| 13551 | (let* ((vhdl-project (nth 0 (car directory-alist))) |
| 13552 | (project (vhdl-project-p)) |
| 13553 | (ent-alist (aget vhdl-entity-alist (or project dir-name) t)) |
| 13554 | (conf-alist (aget vhdl-config-alist (or project dir-name) t)) |
| 13555 | (pack-alist (aget vhdl-package-alist (or project dir-name) t)) |
| 13556 | (ent-inst-list (car (aget vhdl-ent-inst-alist |
| 13557 | (or project dir-name) t))) |
| 13558 | (file-alist (aget vhdl-file-alist (or project dir-name) t)) |
| 13559 | (file-entry (aget file-alist file-name t)) |
| 13560 | (ent-list (nth 0 file-entry)) |
| 13561 | (arch-list (nth 1 file-entry)) |
| 13562 | (arch-ent-list (nth 2 file-entry)) |
| 13563 | (conf-list (nth 3 file-entry)) |
| 13564 | (pack-list (nth 4 file-entry)) |
| 13565 | (pack-body-list (nth 5 file-entry)) |
| 13566 | (inst-ent-list (nth 7 file-entry)) |
| 13567 | (cache-key (or project dir-name)) |
| 13568 | arch-alist key ent-key entry) |
| 13569 | ;; delete design units previously contained in this file: |
| 13570 | ;; entities |
| 13571 | (while ent-list |
| 13572 | (setq key (car ent-list) |
| 13573 | entry (aget ent-alist key t)) |
| 13574 | (when (equal file-name (nth 1 entry)) |
| 13575 | (if (nth 3 entry) |
| 13576 | (aput 'ent-alist key |
| 13577 | (list (nth 0 entry) nil nil (nth 3 entry) nil)) |
| 13578 | (adelete 'ent-alist key))) |
| 13579 | (setq ent-list (cdr ent-list))) |
| 13580 | ;; architectures |
| 13581 | (while arch-list |
| 13582 | (setq key (car arch-list) |
| 13583 | ent-key (car arch-ent-list) |
| 13584 | entry (aget ent-alist ent-key t) |
| 13585 | arch-alist (nth 3 entry)) |
| 13586 | (when (equal file-name (nth 1 (aget arch-alist key t))) |
| 13587 | (adelete 'arch-alist key) |
| 13588 | (if (or (nth 1 entry) arch-alist) |
| 13589 | (aput 'ent-alist ent-key |
| 13590 | (list (nth 0 entry) (nth 1 entry) (nth 2 entry) |
| 13591 | arch-alist (nth 4 entry) (nth 5 entry))) |
| 13592 | (adelete 'ent-alist ent-key))) |
| 13593 | (setq arch-list (cdr arch-list) |
| 13594 | arch-ent-list (cdr arch-ent-list))) |
| 13595 | ;; configurations |
| 13596 | (while conf-list |
| 13597 | (setq key (car conf-list)) |
| 13598 | (when (equal file-name (nth 1 (aget conf-alist key t))) |
| 13599 | (adelete 'conf-alist key)) |
| 13600 | (setq conf-list (cdr conf-list))) |
| 13601 | ;; package declarations |
| 13602 | (while pack-list |
| 13603 | (setq key (car pack-list) |
| 13604 | entry (aget pack-alist key t)) |
| 13605 | (when (equal file-name (nth 1 entry)) |
| 13606 | (if (nth 6 entry) |
| 13607 | (aput 'pack-alist key |
| 13608 | (list (nth 0 entry) nil nil nil nil nil |
| 13609 | (nth 6 entry) (nth 7 entry) (nth 8 entry) |
| 13610 | (nth 9 entry))) |
| 13611 | (adelete 'pack-alist key))) |
| 13612 | (setq pack-list (cdr pack-list))) |
| 13613 | ;; package bodies |
| 13614 | (while pack-body-list |
| 13615 | (setq key (car pack-body-list) |
| 13616 | entry (aget pack-alist key t)) |
| 13617 | (when (equal file-name (nth 6 entry)) |
| 13618 | (if (nth 1 entry) |
| 13619 | (aput 'pack-alist key |
| 13620 | (list (nth 0 entry) (nth 1 entry) (nth 2 entry) |
| 13621 | (nth 3 entry) (nth 4 entry) (nth 5 entry) |
| 13622 | nil nil nil nil)) |
| 13623 | (adelete 'pack-alist key))) |
| 13624 | (setq pack-body-list (cdr pack-body-list))) |
| 13625 | ;; instantiated entities |
| 13626 | (while inst-ent-list |
| 13627 | (setq ent-inst-list |
| 13628 | (vhdl-delete (car inst-ent-list) ent-inst-list)) |
| 13629 | (setq inst-ent-list (cdr inst-ent-list))) |
| 13630 | ;; update caches |
| 13631 | (vhdl-aput 'vhdl-entity-alist cache-key ent-alist) |
| 13632 | (vhdl-aput 'vhdl-config-alist cache-key conf-alist) |
| 13633 | (vhdl-aput 'vhdl-package-alist cache-key pack-alist) |
| 13634 | (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) |
| 13635 | ;; scan file |
| 13636 | (vhdl-scan-directory-contents file-name project t) |
| 13637 | (when (or (and vhdl-speedbar-show-projects project) |
| 13638 | (and (not vhdl-speedbar-show-projects) (not project))) |
| 13639 | (vhdl-speedbar-refresh project)) |
| 13640 | (setq updated t))) |
| 13641 | (setq directory-alist (cdr directory-alist))) |
| 13642 | updated)) |
| 13643 | |
| 13644 | (defun vhdl-update-hierarchy () |
| 13645 | "Update directory and hierarchy information in speedbar." |
| 13646 | (let ((file-list (reverse vhdl-modified-file-list)) |
| 13647 | updated) |
| 13648 | (when (and vhdl-speedbar-update-on-saving file-list) |
| 13649 | (while file-list |
| 13650 | (setq updated |
| 13651 | (or (vhdl-update-file-contents (car file-list)) |
| 13652 | updated)) |
| 13653 | (setq file-list (cdr file-list))) |
| 13654 | (setq vhdl-modified-file-list nil) |
| 13655 | (vhdl-speedbar-update-current-unit) |
| 13656 | (when updated (message "Updating hierarchy...done"))))) |
| 13657 | |
| 13658 | ;; structure (parenthesized expression means list of such entries) |
| 13659 | ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker |
| 13660 | ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker |
| 13661 | ;; comp-lib-name level) |
| 13662 | (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key |
| 13663 | conf-inst-alist level indent |
| 13664 | &optional include-top ent-hier) |
| 13665 | "Get instantiation hierarchy beginning in architecture ARCH-KEY of |
| 13666 | entity ENT-KEY." |
| 13667 | (let* ((ent-entry (aget ent-alist ent-key t)) |
| 13668 | (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t) |
| 13669 | (cdar (last (nth 3 ent-entry))))) |
| 13670 | (inst-alist (nth 3 arch-entry)) |
| 13671 | inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry |
| 13672 | hier-list subcomp-list tmp-list inst-key inst-comp-name |
| 13673 | inst-ent-key inst-arch-key inst-conf-key inst-lib-key) |
| 13674 | (when (= level 0) (message "Extract design hierarchy...")) |
| 13675 | (when include-top |
| 13676 | (setq level (1+ level))) |
| 13677 | (when (member ent-key ent-hier) |
| 13678 | (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) |
| 13679 | ;; check configured architecture (already checked during scanning) |
| 13680 | ; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry))) |
| 13681 | ; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key)) |
| 13682 | ;; process all instances |
| 13683 | (while inst-alist |
| 13684 | (setq inst-entry (car inst-alist) |
| 13685 | inst-key (nth 0 inst-entry) |
| 13686 | inst-comp-name (nth 4 inst-entry) |
| 13687 | inst-conf-key (nth 7 inst-entry)) |
| 13688 | ;; search entry in configuration's instantiations list |
| 13689 | (setq tmp-list conf-inst-alist) |
| 13690 | (while (and tmp-list |
| 13691 | (not (and (member (nth 0 (car tmp-list)) |
| 13692 | (list "all" inst-key)) |
| 13693 | (equal (nth 1 (car tmp-list)) |
| 13694 | (downcase (or inst-comp-name "")))))) |
| 13695 | (setq tmp-list (cdr tmp-list))) |
| 13696 | (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) |
| 13697 | (setq inst-conf-entry (aget conf-alist inst-conf-key t)) |
| 13698 | (when (and inst-conf-key (not inst-conf-entry)) |
| 13699 | (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) |
| 13700 | ;; determine entity |
| 13701 | (setq inst-ent-key |
| 13702 | (or (nth 2 (car tmp-list)) ; from configuration |
| 13703 | (nth 3 inst-conf-entry) ; from subconfiguration |
| 13704 | (nth 3 (aget conf-alist (nth 7 inst-entry) t)) |
| 13705 | ; from configuration spec. |
| 13706 | (nth 5 inst-entry))) ; from direct instantiation |
| 13707 | (setq inst-ent-entry (aget ent-alist inst-ent-key t)) |
| 13708 | ;; determine architecture |
| 13709 | (setq inst-arch-key |
| 13710 | (or (nth 3 (car tmp-list)) ; from configuration |
| 13711 | (nth 4 inst-conf-entry) ; from subconfiguration |
| 13712 | (nth 6 inst-entry) ; from direct instantiation |
| 13713 | (nth 4 (aget conf-alist (nth 7 inst-entry))) |
| 13714 | ; from configuration spec. |
| 13715 | (nth 4 inst-ent-entry) ; MRA |
| 13716 | (caar (nth 3 inst-ent-entry)))) ; first alphabetically |
| 13717 | (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t)) |
| 13718 | ;; set library |
| 13719 | (setq inst-lib-key |
| 13720 | (or (nth 5 (car tmp-list)) ; from configuration |
| 13721 | (nth 8 inst-entry))) ; from direct instantiation |
| 13722 | ;; gather information for this instance |
| 13723 | (setq comp-entry |
| 13724 | (list (nth 1 inst-entry) |
| 13725 | (cons (nth 2 inst-entry) (nth 3 inst-entry)) |
| 13726 | (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) |
| 13727 | (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) |
| 13728 | (or (nth 0 inst-arch-entry) inst-arch-key) |
| 13729 | (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) |
| 13730 | (or (nth 0 inst-conf-entry) inst-conf-key) |
| 13731 | (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) |
| 13732 | inst-lib-key level)) |
| 13733 | ;; get subcomponent hierarchy |
| 13734 | (setq subcomp-list (vhdl-get-hierarchy |
| 13735 | ent-alist conf-alist |
| 13736 | inst-ent-key inst-arch-key inst-conf-key |
| 13737 | (nth 5 inst-conf-entry) |
| 13738 | (1+ level) indent nil (cons ent-key ent-hier))) |
| 13739 | ;; add to list |
| 13740 | (setq hier-list (append hier-list (list comp-entry) subcomp-list)) |
| 13741 | (setq inst-alist (cdr inst-alist))) |
| 13742 | (when include-top |
| 13743 | (setq hier-list |
| 13744 | (cons (list nil nil (nth 0 ent-entry) |
| 13745 | (cons (nth 1 ent-entry) (nth 2 ent-entry)) |
| 13746 | (nth 0 arch-entry) |
| 13747 | (cons (nth 1 arch-entry) (nth 2 arch-entry)) |
| 13748 | nil nil |
| 13749 | nil (1- level)) |
| 13750 | hier-list))) |
| 13751 | (when (or (= level 0) (and include-top (= level 1))) (message "")) |
| 13752 | hier-list)) |
| 13753 | |
| 13754 | (defun vhdl-get-instantiations (ent-key indent) |
| 13755 | "Get all instantiations of entity ENT-KEY." |
| 13756 | (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t)) |
| 13757 | arch-alist inst-alist ent-inst-list |
| 13758 | ent-entry arch-entry inst-entry) |
| 13759 | (while ent-alist |
| 13760 | (setq ent-entry (car ent-alist)) |
| 13761 | (setq arch-alist (nth 4 ent-entry)) |
| 13762 | (while arch-alist |
| 13763 | (setq arch-entry (car arch-alist)) |
| 13764 | (setq inst-alist (nth 4 arch-entry)) |
| 13765 | (while inst-alist |
| 13766 | (setq inst-entry (car inst-alist)) |
| 13767 | (when (equal ent-key (nth 5 inst-entry)) |
| 13768 | (setq ent-inst-list |
| 13769 | (cons (list (nth 1 inst-entry) |
| 13770 | (cons (nth 2 inst-entry) (nth 3 inst-entry)) |
| 13771 | (nth 1 ent-entry) |
| 13772 | (cons (nth 2 ent-entry) (nth 3 ent-entry)) |
| 13773 | (nth 1 arch-entry) |
| 13774 | (cons (nth 2 arch-entry) (nth 3 arch-entry))) |
| 13775 | ent-inst-list))) |
| 13776 | (setq inst-alist (cdr inst-alist))) |
| 13777 | (setq arch-alist (cdr arch-alist))) |
| 13778 | (setq ent-alist (cdr ent-alist))) |
| 13779 | (nreverse ent-inst-list))) |
| 13780 | |
| 13781 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13782 | ;; Caching in file |
| 13783 | |
| 13784 | (defun vhdl-save-caches () |
| 13785 | "Save all updated hierarchy caches to file." |
| 13786 | (interactive) |
| 13787 | (condition-case nil |
| 13788 | (when vhdl-speedbar-save-cache |
| 13789 | ;; update hierarchy |
| 13790 | (vhdl-update-hierarchy) |
| 13791 | (let ((project-list vhdl-updated-project-list)) |
| 13792 | (message "Saving hierarchy caches...") |
| 13793 | ;; write updated project caches |
| 13794 | (while project-list |
| 13795 | (vhdl-save-cache (car project-list)) |
| 13796 | (setq project-list (cdr project-list))) |
| 13797 | (message "Saving hierarchy caches...done"))) |
| 13798 | (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") |
| 13799 | (sit-for 2))))) |
| 13800 | |
| 13801 | (defun vhdl-save-cache (key) |
| 13802 | "Save current hierarchy cache to file." |
| 13803 | (let* ((orig-buffer (current-buffer)) |
| 13804 | (vhdl-project key) |
| 13805 | (project (vhdl-project-p)) |
| 13806 | (default-directory key) |
| 13807 | (directory (abbreviate-file-name (vhdl-default-directory))) |
| 13808 | (file-name (vhdl-resolve-env-variable |
| 13809 | (vhdl-replace-string |
| 13810 | (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) |
| 13811 | (concat |
| 13812 | (subst-char-in-string ? ?_ (or project "dir")) |
| 13813 | " " (user-login-name))))) |
| 13814 | (file-dir-name (expand-file-name file-name directory)) |
| 13815 | (cache-key (or project directory)) |
| 13816 | (key (if project "project" "directory"))) |
| 13817 | (unless (file-exists-p (file-name-directory file-dir-name)) |
| 13818 | (make-directory (file-name-directory file-dir-name) t)) |
| 13819 | (if (not (file-writable-p file-dir-name)) |
| 13820 | (progn (vhdl-warning (format "File not writable: \"%s\"" |
| 13821 | (abbreviate-file-name file-dir-name))) |
| 13822 | (sit-for 2)) |
| 13823 | (message "Saving cache: \"%s\"" file-dir-name) |
| 13824 | (set-buffer (find-file-noselect file-dir-name t t)) |
| 13825 | (erase-buffer) |
| 13826 | (insert ";; -*- Emacs-Lisp -*-\n\n" |
| 13827 | ";;; " (file-name-nondirectory file-name) |
| 13828 | " - design hierarchy cache file for Emacs VHDL Mode " |
| 13829 | vhdl-version "\n") |
| 13830 | (insert "\n;; " (if project "Project " "Directory") " : ") |
| 13831 | (if project (insert project) (prin1 directory (current-buffer))) |
| 13832 | (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") |
| 13833 | (user-login-name) "\n\n" |
| 13834 | "\n;; version number\n" |
| 13835 | "(setq vhdl-cache-version \"" vhdl-version "\")\n" |
| 13836 | "\n;; " (if project "project" "directory") " name" |
| 13837 | "\n(setq " key " ") |
| 13838 | (prin1 (or project directory) (current-buffer)) |
| 13839 | (insert ")\n") |
| 13840 | (when (member 'hierarchy vhdl-speedbar-save-cache) |
| 13841 | (insert "\n;; entity and architecture cache\n" |
| 13842 | "(aput 'vhdl-entity-alist " key " '") |
| 13843 | (print (aget vhdl-entity-alist cache-key t) (current-buffer)) |
| 13844 | (insert ")\n\n;; configuration cache\n" |
| 13845 | "(aput 'vhdl-config-alist " key " '") |
| 13846 | (print (aget vhdl-config-alist cache-key t) (current-buffer)) |
| 13847 | (insert ")\n\n;; package cache\n" |
| 13848 | "(aput 'vhdl-package-alist " key " '") |
| 13849 | (print (aget vhdl-package-alist cache-key t) (current-buffer)) |
| 13850 | (insert ")\n\n;; instantiated entities cache\n" |
| 13851 | "(aput 'vhdl-ent-inst-alist " key " '") |
| 13852 | (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer)) |
| 13853 | (insert ")\n\n;; design units per file cache\n" |
| 13854 | "(aput 'vhdl-file-alist " key " '") |
| 13855 | (print (aget vhdl-file-alist cache-key t) (current-buffer)) |
| 13856 | (when project |
| 13857 | (insert ")\n\n;; source directories in project cache\n" |
| 13858 | "(aput 'vhdl-directory-alist " key " '") |
| 13859 | (print (aget vhdl-directory-alist cache-key t) (current-buffer))) |
| 13860 | (insert ")\n")) |
| 13861 | (when (member 'display vhdl-speedbar-save-cache) |
| 13862 | (insert "\n;; shown design units cache\n" |
| 13863 | "(aput 'vhdl-speedbar-shown-unit-alist " key " '") |
| 13864 | (print (aget vhdl-speedbar-shown-unit-alist cache-key t) |
| 13865 | (current-buffer)) |
| 13866 | (insert ")\n")) |
| 13867 | (setq vhdl-updated-project-list |
| 13868 | (delete cache-key vhdl-updated-project-list)) |
| 13869 | (save-buffer) |
| 13870 | (kill-buffer (current-buffer)) |
| 13871 | (set-buffer orig-buffer)))) |
| 13872 | |
| 13873 | (defun vhdl-load-cache (key) |
| 13874 | "Load hierarchy cache information from file." |
| 13875 | (let* ((vhdl-project key) |
| 13876 | (default-directory key) |
| 13877 | (directory (vhdl-default-directory)) |
| 13878 | (file-name (vhdl-resolve-env-variable |
| 13879 | (vhdl-replace-string |
| 13880 | (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) |
| 13881 | (concat |
| 13882 | (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) |
| 13883 | " " (user-login-name))))) |
| 13884 | (file-dir-name (expand-file-name file-name directory)) |
| 13885 | vhdl-cache-version) |
| 13886 | (unless (memq 'vhdl-save-caches kill-emacs-hook) |
| 13887 | (add-hook 'kill-emacs-hook 'vhdl-save-caches)) |
| 13888 | (when (file-exists-p file-dir-name) |
| 13889 | (condition-case () |
| 13890 | (progn (load-file file-dir-name) |
| 13891 | (string< (mapconcat |
| 13892 | (lambda (a) (format "%3d" (string-to-number a))) |
| 13893 | (split-string "3.33" "\\.") "") |
| 13894 | (mapconcat |
| 13895 | (lambda (a) (format "%3d" (string-to-number a))) |
| 13896 | (split-string vhdl-cache-version "\\.") ""))) |
| 13897 | (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) |
| 13898 | nil)))))) |
| 13899 | |
| 13900 | (defun vhdl-require-hierarchy-info () |
| 13901 | "Make sure that hierarchy information is available. Load cache or scan files |
| 13902 | if required." |
| 13903 | (if (vhdl-project-p) |
| 13904 | (unless (or (assoc vhdl-project vhdl-file-alist) |
| 13905 | (vhdl-load-cache vhdl-project)) |
| 13906 | (vhdl-scan-project-contents vhdl-project)) |
| 13907 | (let ((directory (abbreviate-file-name default-directory))) |
| 13908 | (unless (or (assoc directory vhdl-file-alist) |
| 13909 | (vhdl-load-cache directory)) |
| 13910 | (vhdl-scan-directory-contents directory))))) |
| 13911 | |
| 13912 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13913 | ;; Add hierarchy browser functionality to speedbar |
| 13914 | |
| 13915 | (defvar vhdl-speedbar-key-map nil |
| 13916 | "Keymap used when in the VHDL hierarchy browser mode.") |
| 13917 | |
| 13918 | (defvar vhdl-speedbar-menu-items nil |
| 13919 | "Additional menu-items to add to speedbar frame.") |
| 13920 | |
| 13921 | (defun vhdl-speedbar-initialize () |
| 13922 | "Initialize speedbar." |
| 13923 | ;; general settings |
| 13924 | ; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil) |
| 13925 | ;; VHDL file extensions (extracted from `auto-mode-alist') |
| 13926 | (let ((mode-alist auto-mode-alist)) |
| 13927 | (while mode-alist |
| 13928 | (when (eq (cdar mode-alist) 'vhdl-mode) |
| 13929 | (speedbar-add-supported-extension (caar mode-alist))) |
| 13930 | (setq mode-alist (cdr mode-alist)))) |
| 13931 | ;; hierarchy browser settings |
| 13932 | (when (boundp 'speedbar-mode-functions-list) |
| 13933 | ;; special functions |
| 13934 | (speedbar-add-mode-functions-list |
| 13935 | '("vhdl directory" |
| 13936 | (speedbar-item-info . vhdl-speedbar-item-info) |
| 13937 | (speedbar-line-directory . speedbar-files-line-path))) |
| 13938 | (speedbar-add-mode-functions-list |
| 13939 | '("vhdl project" |
| 13940 | (speedbar-item-info . vhdl-speedbar-item-info) |
| 13941 | (speedbar-line-directory . vhdl-speedbar-line-project))) |
| 13942 | ;; keymap |
| 13943 | (unless vhdl-speedbar-key-map |
| 13944 | (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap)) |
| 13945 | (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line) |
| 13946 | (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line) |
| 13947 | (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line) |
| 13948 | (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line) |
| 13949 | (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level) |
| 13950 | (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all) |
| 13951 | (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy) |
| 13952 | (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component) |
| 13953 | (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration) |
| 13954 | (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra) |
| 13955 | (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design) |
| 13956 | (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy) |
| 13957 | (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches) |
| 13958 | (let ((key 0)) |
| 13959 | (while (<= key 9) |
| 13960 | (define-key vhdl-speedbar-key-map (int-to-string key) |
| 13961 | `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) |
| 13962 | (setq key (1+ key))))) |
| 13963 | (define-key speedbar-key-map "h" |
| 13964 | (lambda () (interactive) |
| 13965 | (speedbar-change-initial-expansion-list "vhdl directory"))) |
| 13966 | (define-key speedbar-key-map "H" |
| 13967 | (lambda () (interactive) |
| 13968 | (speedbar-change-initial-expansion-list "vhdl project"))) |
| 13969 | ;; menu |
| 13970 | (unless vhdl-speedbar-menu-items |
| 13971 | (setq |
| 13972 | vhdl-speedbar-menu-items |
| 13973 | `(["Edit" speedbar-edit-line t] |
| 13974 | ["Expand" speedbar-expand-line |
| 13975 | (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))] |
| 13976 | ["Contract" vhdl-speedbar-contract-level t] |
| 13977 | ["Expand All" vhdl-speedbar-expand-all t] |
| 13978 | ["Contract All" vhdl-speedbar-contract-all t] |
| 13979 | ,(let ((key 0) (menu-list '("Hierarchy Depth"))) |
| 13980 | (while (<= key 9) |
| 13981 | (setq menu-list |
| 13982 | (cons `[,(if (= key 0) "All" (int-to-string key)) |
| 13983 | (vhdl-speedbar-set-depth ,key) |
| 13984 | :style radio |
| 13985 | :selected (= vhdl-speedbar-hierarchy-depth ,key) |
| 13986 | :keys ,(int-to-string key)] |
| 13987 | menu-list)) |
| 13988 | (setq key (1+ key))) |
| 13989 | (nreverse menu-list)) |
| 13990 | "--" |
| 13991 | ["Copy Port/Subprogram" vhdl-speedbar-port-copy |
| 13992 | (or (vhdl-speedbar-check-unit 'entity) |
| 13993 | (vhdl-speedbar-check-unit 'subprogram))] |
| 13994 | ["Place Component" vhdl-speedbar-place-component |
| 13995 | (vhdl-speedbar-check-unit 'entity)] |
| 13996 | ["Generate Configuration" vhdl-speedbar-configuration |
| 13997 | (vhdl-speedbar-check-unit 'architecture)] |
| 13998 | ["Select as MRA" vhdl-speedbar-select-mra |
| 13999 | (vhdl-speedbar-check-unit 'architecture)] |
| 14000 | ["Make" vhdl-speedbar-make-design |
| 14001 | (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] |
| 14002 | ["Generate Makefile" vhdl-speedbar-generate-makefile |
| 14003 | (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] |
| 14004 | ["Rescan Directory" vhdl-speedbar-rescan-hierarchy |
| 14005 | :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) |
| 14006 | ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)] |
| 14007 | ["Rescan Project" vhdl-speedbar-rescan-hierarchy |
| 14008 | :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) |
| 14009 | ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects] |
| 14010 | ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) |
| 14011 | ;; hook-ups |
| 14012 | (speedbar-add-expansion-list |
| 14013 | '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map |
| 14014 | vhdl-speedbar-display-directory)) |
| 14015 | (speedbar-add-expansion-list |
| 14016 | '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map |
| 14017 | vhdl-speedbar-display-projects)) |
| 14018 | (setq speedbar-stealthy-function-list |
| 14019 | (append |
| 14020 | '(("vhdl directory" vhdl-speedbar-update-current-unit) |
| 14021 | ("vhdl project" vhdl-speedbar-update-current-project |
| 14022 | vhdl-speedbar-update-current-unit) |
| 14023 | ; ("files" (lambda () (setq speedbar-ignored-path-regexp |
| 14024 | ; (speedbar-extension-list-to-regex |
| 14025 | ; speedbar-ignored-path-expressions)))) |
| 14026 | ) |
| 14027 | speedbar-stealthy-function-list)) |
| 14028 | (when (eq vhdl-speedbar-display-mode 'directory) |
| 14029 | (setq speedbar-initial-expansion-list-name "vhdl directory")) |
| 14030 | (when (eq vhdl-speedbar-display-mode 'project) |
| 14031 | (setq speedbar-initial-expansion-list-name "vhdl project")) |
| 14032 | (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) |
| 14033 | |
| 14034 | (defun vhdl-speedbar (&optional arg) |
| 14035 | "Open/close speedbar." |
| 14036 | (interactive) |
| 14037 | (if (not (fboundp 'speedbar)) |
| 14038 | (error "WARNING: Speedbar is not available or not installed") |
| 14039 | (condition-case () |
| 14040 | (speedbar-frame-mode arg) |
| 14041 | (error (error "WARNING: An error occurred while opening speedbar"))))) |
| 14042 | |
| 14043 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 14044 | ;; Display functions |
| 14045 | |
| 14046 | (defvar vhdl-speedbar-last-selected-project nil |
| 14047 | "Name of last selected project.") |
| 14048 | |
| 14049 | ;; macros must be defined in the file they are used (copied from `speedbar.el') |
| 14050 | (defmacro speedbar-with-writable (&rest forms) |
| 14051 | "Allow the buffer to be writable and evaluate FORMS." |
| 14052 | (list 'let '((inhibit-read-only t)) |
| 14053 | (cons 'progn forms))) |
| 14054 | (put 'speedbar-with-writable 'lisp-indent-function 0) |
| 14055 | |
| 14056 | (defun vhdl-speedbar-display-directory (directory depth &optional rescan) |
| 14057 | "Display directory and hierarchy information in speedbar." |
| 14058 | (setq vhdl-speedbar-show-projects nil) |
| 14059 | (setq speedbar-ignored-directory-regexp |
| 14060 | (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) |
| 14061 | (setq directory (abbreviate-file-name (file-name-as-directory directory))) |
| 14062 | (setq speedbar-last-selected-file nil) |
| 14063 | (speedbar-with-writable |
| 14064 | (condition-case nil |
| 14065 | (progn |
| 14066 | ;; insert directory path |
| 14067 | (speedbar-directory-buttons directory depth) |
| 14068 | ;; insert subdirectories |
| 14069 | (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth) |
| 14070 | ;; scan and insert hierarchy of current directory |
| 14071 | (vhdl-speedbar-insert-dir-hierarchy directory depth |
| 14072 | speedbar-power-click) |
| 14073 | ;; expand subdirectories |
| 14074 | (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) |
| 14075 | (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) |
| 14076 | |
| 14077 | (defun vhdl-speedbar-display-projects (project depth &optional rescan) |
| 14078 | "Display projects and hierarchy information in speedbar." |
| 14079 | (setq vhdl-speedbar-show-projects t) |
| 14080 | (setq speedbar-ignored-directory-regexp ".") |
| 14081 | (setq speedbar-last-selected-file nil) |
| 14082 | (setq vhdl-speedbar-last-selected-project nil) |
| 14083 | (speedbar-with-writable |
| 14084 | (condition-case nil |
| 14085 | ;; insert projects |
| 14086 | (vhdl-speedbar-insert-projects) |
| 14087 | (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) |
| 14088 | (setq speedbar-full-text-cache nil)) ; prevent caching |
| 14089 | |
| 14090 | (defun vhdl-speedbar-insert-projects () |
| 14091 | "Insert all projects in speedbar." |
| 14092 | (vhdl-speedbar-make-title-line "Projects:") |
| 14093 | (let ((project-alist (if vhdl-project-sort |
| 14094 | (vhdl-sort-alist (copy-alist vhdl-project-alist)) |
| 14095 | vhdl-project-alist)) |
| 14096 | (vhdl-speedbar-update-current-unit nil)) |
| 14097 | ;; insert projects |
| 14098 | (while project-alist |
| 14099 | (speedbar-make-tag-line |
| 14100 | 'angle ?+ 'vhdl-speedbar-expand-project |
| 14101 | (caar project-alist) (caar project-alist) |
| 14102 | 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) |
| 14103 | (setq project-alist (cdr project-alist))) |
| 14104 | (setq project-alist vhdl-project-alist) |
| 14105 | ;; expand projects |
| 14106 | (while project-alist |
| 14107 | (when (member (caar project-alist) vhdl-speedbar-shown-project-list) |
| 14108 | (goto-char (point-min)) |
| 14109 | (when (re-search-forward |
| 14110 | (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) |
| 14111 | (goto-char (match-end 1)) |
| 14112 | (speedbar-do-function-pointer))) |
| 14113 | (setq project-alist (cdr project-alist)))) |
| 14114 | ; (vhdl-speedbar-update-current-project) |
| 14115 | ; (vhdl-speedbar-update-current-unit nil t) |
| 14116 | ) |
| 14117 | |
| 14118 | (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) |
| 14119 | "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, |
| 14120 | otherwise use cached data." |
| 14121 | (when (or rescan (and (not (assoc project vhdl-file-alist)) |
| 14122 | (not (vhdl-load-cache project)))) |
| 14123 | (vhdl-scan-project-contents project)) |
| 14124 | ;; insert design hierarchy |
| 14125 | (vhdl-speedbar-insert-hierarchy |
| 14126 | (aget vhdl-entity-alist project t) |
| 14127 | (aget vhdl-config-alist project t) |
| 14128 | (aget vhdl-package-alist project t) |
| 14129 | (car (aget vhdl-ent-inst-alist project t)) indent) |
| 14130 | (insert (int-to-string indent) ":\n") |
| 14131 | (put-text-property (- (point) 3) (1- (point)) 'invisible t) |
| 14132 | (put-text-property (1- (point)) (point) 'invisible nil) |
| 14133 | ;; expand design units |
| 14134 | (vhdl-speedbar-expand-units project)) |
| 14135 | |
| 14136 | (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) |
| 14137 | "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil, |
| 14138 | otherwise use cached data." |
| 14139 | (when (or rescan (and (not (assoc directory vhdl-file-alist)) |
| 14140 | (not (vhdl-load-cache directory)))) |
| 14141 | (vhdl-scan-directory-contents directory)) |
| 14142 | ;; insert design hierarchy |
| 14143 | (vhdl-speedbar-insert-hierarchy |
| 14144 | (aget vhdl-entity-alist directory t) |
| 14145 | (aget vhdl-config-alist directory t) |
| 14146 | (aget vhdl-package-alist directory t) |
| 14147 | (car (aget vhdl-ent-inst-alist directory t)) depth) |
| 14148 | ;; expand design units |
| 14149 | (vhdl-speedbar-expand-units directory) |
| 14150 | (aput 'vhdl-directory-alist directory (list (list directory)))) |
| 14151 | |
| 14152 | (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist |
| 14153 | ent-inst-list depth) |
| 14154 | "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." |
| 14155 | (if (not (or ent-alist conf-alist pack-alist)) |
| 14156 | (vhdl-speedbar-make-title-line "No VHDL design units!" depth) |
| 14157 | (let (ent-entry conf-entry pack-entry) |
| 14158 | ;; insert entities |
| 14159 | (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) |
| 14160 | (while ent-alist |
| 14161 | (setq ent-entry (car ent-alist)) |
| 14162 | (speedbar-make-tag-line |
| 14163 | 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) |
| 14164 | (nth 1 ent-entry) 'vhdl-speedbar-find-file |
| 14165 | (cons (nth 2 ent-entry) (nth 3 ent-entry)) |
| 14166 | 'vhdl-speedbar-entity-face depth) |
| 14167 | (unless (nth 2 ent-entry) |
| 14168 | (end-of-line 0) (insert "!") (forward-char 1)) |
| 14169 | (unless (member (nth 0 ent-entry) ent-inst-list) |
| 14170 | (end-of-line 0) (insert " (top)") (forward-char 1)) |
| 14171 | (setq ent-alist (cdr ent-alist))) |
| 14172 | ;; insert configurations |
| 14173 | (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) |
| 14174 | (while conf-alist |
| 14175 | (setq conf-entry (car conf-alist)) |
| 14176 | (speedbar-make-tag-line |
| 14177 | 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) |
| 14178 | (nth 1 conf-entry) 'vhdl-speedbar-find-file |
| 14179 | (cons (nth 2 conf-entry) (nth 3 conf-entry)) |
| 14180 | 'vhdl-speedbar-configuration-face depth) |
| 14181 | (setq conf-alist (cdr conf-alist))) |
| 14182 | ;; insert packages |
| 14183 | (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) |
| 14184 | (while pack-alist |
| 14185 | (setq pack-entry (car pack-alist)) |
| 14186 | (vhdl-speedbar-make-pack-line |
| 14187 | (nth 0 pack-entry) (nth 1 pack-entry) |
| 14188 | (cons (nth 2 pack-entry) (nth 3 pack-entry)) |
| 14189 | (cons (nth 7 pack-entry) (nth 8 pack-entry)) |
| 14190 | depth) |
| 14191 | (setq pack-alist (cdr pack-alist)))))) |
| 14192 | |
| 14193 | (defun vhdl-speedbar-rescan-hierarchy () |
| 14194 | "Rescan hierarchy for the directory or project under the cursor." |
| 14195 | (interactive) |
| 14196 | (let (key path) |
| 14197 | (cond |
| 14198 | ;; current project |
| 14199 | (vhdl-speedbar-show-projects |
| 14200 | (setq key (vhdl-speedbar-line-project)) |
| 14201 | (vhdl-scan-project-contents key)) |
| 14202 | ;; top-level directory |
| 14203 | ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) |
| 14204 | (re-search-forward "[0-9]+:" nil t) |
| 14205 | (vhdl-scan-directory-contents |
| 14206 | (abbreviate-file-name (speedbar-line-directory)))) |
| 14207 | ;; current directory |
| 14208 | (t (setq path (speedbar-line-directory)) |
| 14209 | (string-match "^\\(.+[/\\]\\)" path) |
| 14210 | (vhdl-scan-directory-contents |
| 14211 | (abbreviate-file-name (match-string 1 path))))) |
| 14212 | (vhdl-speedbar-refresh key))) |
| 14213 | |
| 14214 | (defun vhdl-speedbar-expand-dirs (directory) |
| 14215 | "Expand subdirectories in DIRECTORY according to |
| 14216 | `speedbar-shown-directories'." |
| 14217 | ;; (nicked from `speedbar-default-directory-list') |
| 14218 | (let ((sf (cdr (reverse speedbar-shown-directories))) |
| 14219 | (vhdl-speedbar-update-current-unit nil)) |
| 14220 | (setq speedbar-shown-directories |
| 14221 | (list (expand-file-name default-directory))) |
| 14222 | (while sf |
| 14223 | (when (speedbar-goto-this-file (car sf)) |
| 14224 | (beginning-of-line) |
| 14225 | (when (looking-at "[0-9]+:\\s-*<") |
| 14226 | (goto-char (match-end 0)) |
| 14227 | (speedbar-do-function-pointer))) |
| 14228 | (setq sf (cdr sf)))) |
| 14229 | (vhdl-speedbar-update-current-unit nil t)) |
| 14230 | |
| 14231 | (defun vhdl-speedbar-expand-units (key) |
| 14232 | "Expand design units in directory/project KEY according to |
| 14233 | `vhdl-speedbar-shown-unit-alist'." |
| 14234 | (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) |
| 14235 | (vhdl-speedbar-update-current-unit nil) |
| 14236 | vhdl-updated-project-list) |
| 14237 | (adelete 'vhdl-speedbar-shown-unit-alist key) |
| 14238 | (vhdl-prepare-search-1 |
| 14239 | (while unit-alist ; expand units |
| 14240 | (vhdl-speedbar-goto-this-unit key (caar unit-alist)) |
| 14241 | (beginning-of-line) |
| 14242 | (let ((arch-alist (nth 1 (car unit-alist))) |
| 14243 | position) |
| 14244 | (when (looking-at "^[0-9]+:\\s-*\\[") |
| 14245 | (goto-char (match-end 0)) |
| 14246 | (setq position (point)) |
| 14247 | (speedbar-do-function-pointer) |
| 14248 | (select-frame speedbar-frame) |
| 14249 | (while arch-alist ; expand architectures |
| 14250 | (goto-char position) |
| 14251 | (when (re-search-forward |
| 14252 | (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" |
| 14253 | (car arch-alist) "\\>\\)") nil t) |
| 14254 | (beginning-of-line) |
| 14255 | (when (looking-at "^[0-9]+:\\s-*{") |
| 14256 | (goto-char (match-end 0)) |
| 14257 | (speedbar-do-function-pointer) |
| 14258 | (select-frame speedbar-frame))) |
| 14259 | (setq arch-alist (cdr arch-alist)))) |
| 14260 | (setq unit-alist (cdr unit-alist)))))) |
| 14261 | (vhdl-speedbar-update-current-unit nil t)) |
| 14262 | |
| 14263 | (defun vhdl-speedbar-contract-level () |
| 14264 | "Contract current level in current directory/project." |
| 14265 | (interactive) |
| 14266 | (when (or (save-excursion |
| 14267 | (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) |
| 14268 | (and (save-excursion |
| 14269 | (beginning-of-line) (looking-at "^\\([0-9]+\\):")) |
| 14270 | (re-search-backward |
| 14271 | (format "^[0-%d]:\\s-*[[{<]-" |
| 14272 | (max (1- (string-to-number (match-string 1))) 0)) nil t))) |
| 14273 | (goto-char (match-end 0)) |
| 14274 | (speedbar-do-function-pointer) |
| 14275 | (speedbar-center-buffer-smartly))) |
| 14276 | |
| 14277 | (defun vhdl-speedbar-contract-all () |
| 14278 | "Contract all expanded design units in current directory/project." |
| 14279 | (interactive) |
| 14280 | (if (and vhdl-speedbar-show-projects |
| 14281 | (save-excursion (beginning-of-line) (looking-at "^0:"))) |
| 14282 | (progn (setq vhdl-speedbar-shown-project-list nil) |
| 14283 | (vhdl-speedbar-refresh)) |
| 14284 | (let ((key (vhdl-speedbar-line-key))) |
| 14285 | (adelete 'vhdl-speedbar-shown-unit-alist key) |
| 14286 | (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) |
| 14287 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14288 | (add-to-list 'vhdl-updated-project-list key))))) |
| 14289 | |
| 14290 | (defun vhdl-speedbar-expand-all () |
| 14291 | "Expand all design units in current directory/project." |
| 14292 | (interactive) |
| 14293 | (let* ((key (vhdl-speedbar-line-key)) |
| 14294 | (ent-alist (aget vhdl-entity-alist key t)) |
| 14295 | (conf-alist (aget vhdl-config-alist key t)) |
| 14296 | (pack-alist (aget vhdl-package-alist key t)) |
| 14297 | arch-alist unit-alist subunit-alist) |
| 14298 | (add-to-list 'vhdl-speedbar-shown-project-list key) |
| 14299 | (while ent-alist |
| 14300 | (setq arch-alist (nth 4 (car ent-alist))) |
| 14301 | (setq subunit-alist nil) |
| 14302 | (while arch-alist |
| 14303 | (setq subunit-alist (cons (caar arch-alist) subunit-alist)) |
| 14304 | (setq arch-alist (cdr arch-alist))) |
| 14305 | (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist)) |
| 14306 | (setq ent-alist (cdr ent-alist))) |
| 14307 | (while conf-alist |
| 14308 | (setq unit-alist (cons (list (caar conf-alist)) unit-alist)) |
| 14309 | (setq conf-alist (cdr conf-alist))) |
| 14310 | (while pack-alist |
| 14311 | (setq unit-alist (cons (list (caar pack-alist)) unit-alist)) |
| 14312 | (setq pack-alist (cdr pack-alist))) |
| 14313 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14314 | (vhdl-speedbar-refresh) |
| 14315 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14316 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14317 | |
| 14318 | (defun vhdl-speedbar-expand-project (text token indent) |
| 14319 | "Expand/contract the project under the cursor." |
| 14320 | (cond |
| 14321 | ((string-match "+" text) ; expand project |
| 14322 | (speedbar-change-expand-button-char ?-) |
| 14323 | (unless (member token vhdl-speedbar-shown-project-list) |
| 14324 | (setq vhdl-speedbar-shown-project-list |
| 14325 | (cons token vhdl-speedbar-shown-project-list))) |
| 14326 | (speedbar-with-writable |
| 14327 | (save-excursion |
| 14328 | (end-of-line) (forward-char 1) |
| 14329 | (vhdl-speedbar-insert-project-hierarchy token (1+ indent) |
| 14330 | speedbar-power-click)))) |
| 14331 | ((string-match "-" text) ; contract project |
| 14332 | (speedbar-change-expand-button-char ?+) |
| 14333 | (setq vhdl-speedbar-shown-project-list |
| 14334 | (delete token vhdl-speedbar-shown-project-list)) |
| 14335 | (speedbar-delete-subblock indent)) |
| 14336 | (t (error "Nothing to display"))) |
| 14337 | (when (equal (selected-frame) speedbar-frame) |
| 14338 | (speedbar-center-buffer-smartly))) |
| 14339 | |
| 14340 | (defun vhdl-speedbar-expand-entity (text token indent) |
| 14341 | "Expand/contract the entity under the cursor." |
| 14342 | (cond |
| 14343 | ((string-match "+" text) ; expand entity |
| 14344 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14345 | (ent-alist (aget vhdl-entity-alist key t)) |
| 14346 | (ent-entry (aget ent-alist token t)) |
| 14347 | (arch-alist (nth 3 ent-entry)) |
| 14348 | (inst-alist (vhdl-get-instantiations token indent)) |
| 14349 | (subpack-alist (nth 5 ent-entry)) |
| 14350 | (multiple-arch (> (length arch-alist) 1)) |
| 14351 | arch-entry inst-entry) |
| 14352 | (if (not (or arch-alist inst-alist subpack-alist)) |
| 14353 | (speedbar-change-expand-button-char ??) |
| 14354 | (speedbar-change-expand-button-char ?-) |
| 14355 | ;; add entity to `vhdl-speedbar-shown-unit-alist' |
| 14356 | (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14357 | (aput 'unit-alist token nil) |
| 14358 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 14359 | (speedbar-with-writable |
| 14360 | (save-excursion |
| 14361 | (end-of-line) (forward-char 1) |
| 14362 | ;; insert architectures |
| 14363 | (when arch-alist |
| 14364 | (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) |
| 14365 | (while arch-alist |
| 14366 | (setq arch-entry (car arch-alist)) |
| 14367 | (speedbar-make-tag-line |
| 14368 | 'curly ?+ 'vhdl-speedbar-expand-architecture |
| 14369 | (cons token (nth 0 arch-entry)) |
| 14370 | (nth 1 arch-entry) 'vhdl-speedbar-find-file |
| 14371 | (cons (nth 2 arch-entry) (nth 3 arch-entry)) |
| 14372 | 'vhdl-speedbar-architecture-face (1+ indent)) |
| 14373 | (when (and multiple-arch |
| 14374 | (equal (nth 0 arch-entry) (nth 4 ent-entry))) |
| 14375 | (end-of-line 0) (insert " (mra)") (forward-char 1)) |
| 14376 | (setq arch-alist (cdr arch-alist))) |
| 14377 | ;; insert instantiations |
| 14378 | (when inst-alist |
| 14379 | (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) |
| 14380 | (while inst-alist |
| 14381 | (setq inst-entry (car inst-alist)) |
| 14382 | (vhdl-speedbar-make-inst-line |
| 14383 | (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) |
| 14384 | (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) |
| 14385 | nil nil nil (1+ indent) 0 " in ") |
| 14386 | (setq inst-alist (cdr inst-alist))) |
| 14387 | ;; insert required packages |
| 14388 | (vhdl-speedbar-insert-subpackages |
| 14389 | subpack-alist (1+ indent) indent))) |
| 14390 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14391 | (add-to-list 'vhdl-updated-project-list key)) |
| 14392 | (vhdl-speedbar-update-current-unit t t)))) |
| 14393 | ((string-match "-" text) ; contract entity |
| 14394 | (speedbar-change-expand-button-char ?+) |
| 14395 | ;; remove entity from `vhdl-speedbar-shown-unit-alist' |
| 14396 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14397 | (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14398 | (adelete 'unit-alist token) |
| 14399 | (if unit-alist |
| 14400 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14401 | (adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 14402 | (speedbar-delete-subblock indent) |
| 14403 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14404 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14405 | (t (error "Nothing to display"))) |
| 14406 | (when (equal (selected-frame) speedbar-frame) |
| 14407 | (speedbar-center-buffer-smartly))) |
| 14408 | |
| 14409 | (defun vhdl-speedbar-expand-architecture (text token indent) |
| 14410 | "Expand/contract the architecture under the cursor." |
| 14411 | (cond |
| 14412 | ((string-match "+" text) ; expand architecture |
| 14413 | (let* ((key (vhdl-speedbar-line-key (1- indent))) |
| 14414 | (ent-alist (aget vhdl-entity-alist key t)) |
| 14415 | (conf-alist (aget vhdl-config-alist key t)) |
| 14416 | (hier-alist (vhdl-get-hierarchy |
| 14417 | ent-alist conf-alist (car token) (cdr token) nil nil |
| 14418 | 0 (1- indent))) |
| 14419 | (ent-entry (aget ent-alist (car token) t)) |
| 14420 | (arch-entry (aget (nth 3 ent-entry) (cdr token) t)) |
| 14421 | (subpack-alist (nth 4 arch-entry)) |
| 14422 | entry) |
| 14423 | (if (not (or hier-alist subpack-alist)) |
| 14424 | (speedbar-change-expand-button-char ??) |
| 14425 | (speedbar-change-expand-button-char ?-) |
| 14426 | ;; add architecture to `vhdl-speedbar-shown-unit-alist' |
| 14427 | (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) |
| 14428 | (arch-alist (nth 0 (aget unit-alist (car token) t)))) |
| 14429 | (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist))) |
| 14430 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 14431 | (speedbar-with-writable |
| 14432 | (save-excursion |
| 14433 | (end-of-line) (forward-char 1) |
| 14434 | ;; insert instance hierarchy |
| 14435 | (when hier-alist |
| 14436 | (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" |
| 14437 | (1+ indent))) |
| 14438 | (while hier-alist |
| 14439 | (setq entry (car hier-alist)) |
| 14440 | (when (or (= vhdl-speedbar-hierarchy-depth 0) |
| 14441 | (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) |
| 14442 | (vhdl-speedbar-make-inst-line |
| 14443 | (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) |
| 14444 | (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) |
| 14445 | (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) |
| 14446 | (setq hier-alist (cdr hier-alist))) |
| 14447 | ;; insert required packages |
| 14448 | (vhdl-speedbar-insert-subpackages |
| 14449 | subpack-alist (1+ indent) (1- indent)))) |
| 14450 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14451 | (add-to-list 'vhdl-updated-project-list key)) |
| 14452 | (vhdl-speedbar-update-current-unit t t)))) |
| 14453 | ((string-match "-" text) ; contract architecture |
| 14454 | (speedbar-change-expand-button-char ?+) |
| 14455 | ;; remove architecture from `vhdl-speedbar-shown-unit-alist' |
| 14456 | (let* ((key (vhdl-speedbar-line-key (1- indent))) |
| 14457 | (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) |
| 14458 | (arch-alist (nth 0 (aget unit-alist (car token) t)))) |
| 14459 | (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) |
| 14460 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14461 | (speedbar-delete-subblock indent) |
| 14462 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14463 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14464 | (t (error "Nothing to display"))) |
| 14465 | (when (equal (selected-frame) speedbar-frame) |
| 14466 | (speedbar-center-buffer-smartly))) |
| 14467 | |
| 14468 | (defun vhdl-speedbar-expand-config (text token indent) |
| 14469 | "Expand/contract the configuration under the cursor." |
| 14470 | (cond |
| 14471 | ((string-match "+" text) ; expand configuration |
| 14472 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14473 | (conf-alist (aget vhdl-config-alist key t)) |
| 14474 | (conf-entry (aget conf-alist token)) |
| 14475 | (ent-alist (aget vhdl-entity-alist key t)) |
| 14476 | (hier-alist (vhdl-get-hierarchy |
| 14477 | ent-alist conf-alist (nth 3 conf-entry) |
| 14478 | (nth 4 conf-entry) token (nth 5 conf-entry) |
| 14479 | 0 indent t)) |
| 14480 | (subpack-alist (nth 6 conf-entry)) |
| 14481 | entry) |
| 14482 | (if (not (or hier-alist subpack-alist)) |
| 14483 | (speedbar-change-expand-button-char ??) |
| 14484 | (speedbar-change-expand-button-char ?-) |
| 14485 | ;; add configuration to `vhdl-speedbar-shown-unit-alist' |
| 14486 | (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14487 | (aput 'unit-alist token nil) |
| 14488 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 14489 | (speedbar-with-writable |
| 14490 | (save-excursion |
| 14491 | (end-of-line) (forward-char 1) |
| 14492 | ;; insert instance hierarchy |
| 14493 | (when hier-alist |
| 14494 | (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) |
| 14495 | (while hier-alist |
| 14496 | (setq entry (car hier-alist)) |
| 14497 | (when (or (= vhdl-speedbar-hierarchy-depth 0) |
| 14498 | (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) |
| 14499 | (vhdl-speedbar-make-inst-line |
| 14500 | (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) |
| 14501 | (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) |
| 14502 | (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) |
| 14503 | (setq hier-alist (cdr hier-alist))) |
| 14504 | ;; insert required packages |
| 14505 | (vhdl-speedbar-insert-subpackages |
| 14506 | subpack-alist (1+ indent) indent))) |
| 14507 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14508 | (add-to-list 'vhdl-updated-project-list key)) |
| 14509 | (vhdl-speedbar-update-current-unit t t)))) |
| 14510 | ((string-match "-" text) ; contract configuration |
| 14511 | (speedbar-change-expand-button-char ?+) |
| 14512 | ;; remove configuration from `vhdl-speedbar-shown-unit-alist' |
| 14513 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14514 | (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14515 | (adelete 'unit-alist token) |
| 14516 | (if unit-alist |
| 14517 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14518 | (adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 14519 | (speedbar-delete-subblock indent) |
| 14520 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14521 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14522 | (t (error "Nothing to display"))) |
| 14523 | (when (equal (selected-frame) speedbar-frame) |
| 14524 | (speedbar-center-buffer-smartly))) |
| 14525 | |
| 14526 | (defun vhdl-speedbar-expand-package (text token indent) |
| 14527 | "Expand/contract the package under the cursor." |
| 14528 | (cond |
| 14529 | ((string-match "+" text) ; expand package |
| 14530 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14531 | (pack-alist (aget vhdl-package-alist key t)) |
| 14532 | (pack-entry (aget pack-alist token t)) |
| 14533 | (comp-alist (nth 3 pack-entry)) |
| 14534 | (func-alist (nth 4 pack-entry)) |
| 14535 | (func-body-alist (nth 8 pack-entry)) |
| 14536 | (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) |
| 14537 | comp-entry func-entry func-body-entry) |
| 14538 | (if (not (or comp-alist func-alist subpack-alist)) |
| 14539 | (speedbar-change-expand-button-char ??) |
| 14540 | (speedbar-change-expand-button-char ?-) |
| 14541 | ;; add package to `vhdl-speedbar-shown-unit-alist' |
| 14542 | (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14543 | (aput 'unit-alist token nil) |
| 14544 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 14545 | (speedbar-with-writable |
| 14546 | (save-excursion |
| 14547 | (end-of-line) (forward-char 1) |
| 14548 | ;; insert components |
| 14549 | (when comp-alist |
| 14550 | (vhdl-speedbar-make-title-line "Components:" (1+ indent))) |
| 14551 | (while comp-alist |
| 14552 | (setq comp-entry (car comp-alist)) |
| 14553 | (speedbar-make-tag-line |
| 14554 | nil nil nil |
| 14555 | (cons token (nth 0 comp-entry)) |
| 14556 | (nth 1 comp-entry) 'vhdl-speedbar-find-file |
| 14557 | (cons (nth 2 comp-entry) (nth 3 comp-entry)) |
| 14558 | 'vhdl-speedbar-entity-face (1+ indent)) |
| 14559 | (setq comp-alist (cdr comp-alist))) |
| 14560 | ;; insert subprograms |
| 14561 | (when func-alist |
| 14562 | (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) |
| 14563 | (while func-alist |
| 14564 | (setq func-entry (car func-alist) |
| 14565 | func-body-entry (aget func-body-alist (car func-entry) t)) |
| 14566 | (when (nth 2 func-entry) |
| 14567 | (vhdl-speedbar-make-subprogram-line |
| 14568 | (nth 1 func-entry) |
| 14569 | (cons (nth 2 func-entry) (nth 3 func-entry)) |
| 14570 | (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) |
| 14571 | (1+ indent))) |
| 14572 | (setq func-alist (cdr func-alist))) |
| 14573 | ;; insert required packages |
| 14574 | (vhdl-speedbar-insert-subpackages |
| 14575 | subpack-alist (1+ indent) indent))) |
| 14576 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14577 | (add-to-list 'vhdl-updated-project-list key)) |
| 14578 | (vhdl-speedbar-update-current-unit t t)))) |
| 14579 | ((string-match "-" text) ; contract package |
| 14580 | (speedbar-change-expand-button-char ?+) |
| 14581 | ;; remove package from `vhdl-speedbar-shown-unit-alist' |
| 14582 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 14583 | (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) |
| 14584 | (adelete 'unit-alist token) |
| 14585 | (if unit-alist |
| 14586 | (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14587 | (adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 14588 | (speedbar-delete-subblock indent) |
| 14589 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14590 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14591 | (t (error "Nothing to display"))) |
| 14592 | (when (equal (selected-frame) speedbar-frame) |
| 14593 | (speedbar-center-buffer-smartly))) |
| 14594 | |
| 14595 | (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) |
| 14596 | "Insert required packages." |
| 14597 | (let* ((pack-alist (aget vhdl-package-alist |
| 14598 | (vhdl-speedbar-line-key dir-indent) t)) |
| 14599 | pack-key lib-name pack-entry) |
| 14600 | (when subpack-alist |
| 14601 | (vhdl-speedbar-make-title-line "Packages Used:" indent)) |
| 14602 | (while subpack-alist |
| 14603 | (setq pack-key (cdar subpack-alist) |
| 14604 | lib-name (caar subpack-alist)) |
| 14605 | (setq pack-entry (aget pack-alist pack-key t)) |
| 14606 | (vhdl-speedbar-make-subpack-line |
| 14607 | (or (nth 0 pack-entry) pack-key) lib-name |
| 14608 | (cons (nth 1 pack-entry) (nth 2 pack-entry)) |
| 14609 | (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) |
| 14610 | (setq subpack-alist (cdr subpack-alist))))) |
| 14611 | |
| 14612 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 14613 | ;; Display help functions |
| 14614 | |
| 14615 | (defvar vhdl-speedbar-update-current-unit t |
| 14616 | "Non-nil means to run `vhdl-speedbar-update-current-unit'.") |
| 14617 | |
| 14618 | (defun vhdl-speedbar-update-current-project () |
| 14619 | "Highlight project that is currently active." |
| 14620 | (when (and vhdl-speedbar-show-projects |
| 14621 | (not (equal vhdl-speedbar-last-selected-project vhdl-project)) |
| 14622 | (and (boundp 'speedbar-frame) |
| 14623 | (frame-live-p speedbar-frame))) |
| 14624 | (let ((last-frame (selected-frame)) |
| 14625 | (project-alist vhdl-project-alist) |
| 14626 | pos) |
| 14627 | (select-frame speedbar-frame) |
| 14628 | (speedbar-with-writable |
| 14629 | (save-excursion |
| 14630 | (while project-alist |
| 14631 | (goto-char (point-min)) |
| 14632 | (when (re-search-forward |
| 14633 | (concat "<.> \\(" (caar project-alist) "\\)$") nil t) |
| 14634 | (put-text-property (match-beginning 1) (match-end 1) 'face |
| 14635 | (if (equal (caar project-alist) vhdl-project) |
| 14636 | 'speedbar-selected-face |
| 14637 | 'speedbar-directory-face)) |
| 14638 | (when (equal (caar project-alist) vhdl-project) |
| 14639 | (setq pos (1- (match-beginning 1))))) |
| 14640 | (setq project-alist (cdr project-alist)))) |
| 14641 | (when pos (goto-char pos))) |
| 14642 | (select-frame last-frame) |
| 14643 | (setq vhdl-speedbar-last-selected-project vhdl-project))) |
| 14644 | t) |
| 14645 | |
| 14646 | (defun vhdl-speedbar-update-current-unit (&optional no-position always) |
| 14647 | "Highlight all design units that are contained in the current file. |
| 14648 | NO-POSITION non-nil means do not re-position cursor." |
| 14649 | (let ((last-frame (selected-frame)) |
| 14650 | (project-list vhdl-speedbar-shown-project-list) |
| 14651 | file-alist pos file-name) |
| 14652 | ;; get current file name |
| 14653 | (if (fboundp 'speedbar-select-attached-frame) |
| 14654 | (speedbar-select-attached-frame) |
| 14655 | (select-frame speedbar-attached-frame)) |
| 14656 | (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) |
| 14657 | (when (and vhdl-speedbar-update-current-unit |
| 14658 | (or always (not (equal file-name speedbar-last-selected-file)))) |
| 14659 | (if vhdl-speedbar-show-projects |
| 14660 | (while project-list |
| 14661 | (setq file-alist (append file-alist (aget vhdl-file-alist |
| 14662 | (car project-list) t))) |
| 14663 | (setq project-list (cdr project-list))) |
| 14664 | (setq file-alist (aget vhdl-file-alist |
| 14665 | (abbreviate-file-name default-directory) t))) |
| 14666 | (select-frame speedbar-frame) |
| 14667 | (set-buffer speedbar-buffer) |
| 14668 | (speedbar-with-writable |
| 14669 | (vhdl-prepare-search-1 |
| 14670 | (save-excursion |
| 14671 | ;; unhighlight last units |
| 14672 | (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) |
| 14673 | (vhdl-speedbar-update-units |
| 14674 | "\\[.\\] " (nth 0 file-entry) |
| 14675 | speedbar-last-selected-file 'vhdl-speedbar-entity-face) |
| 14676 | (vhdl-speedbar-update-units |
| 14677 | "{.} " (nth 1 file-entry) |
| 14678 | speedbar-last-selected-file 'vhdl-speedbar-architecture-face) |
| 14679 | (vhdl-speedbar-update-units |
| 14680 | "\\[.\\] " (nth 3 file-entry) |
| 14681 | speedbar-last-selected-file 'vhdl-speedbar-configuration-face) |
| 14682 | (vhdl-speedbar-update-units |
| 14683 | "[]>] " (nth 4 file-entry) |
| 14684 | speedbar-last-selected-file 'vhdl-speedbar-package-face) |
| 14685 | (vhdl-speedbar-update-units |
| 14686 | "\\[.\\].+(" '("body") |
| 14687 | speedbar-last-selected-file 'vhdl-speedbar-package-face) |
| 14688 | (vhdl-speedbar-update-units |
| 14689 | "> " (nth 6 file-entry) |
| 14690 | speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) |
| 14691 | ;; highlight current units |
| 14692 | (let* ((file-entry (aget file-alist file-name t))) |
| 14693 | (setq |
| 14694 | pos (vhdl-speedbar-update-units |
| 14695 | "\\[.\\] " (nth 0 file-entry) |
| 14696 | file-name 'vhdl-speedbar-entity-selected-face pos) |
| 14697 | pos (vhdl-speedbar-update-units |
| 14698 | "{.} " (nth 1 file-entry) |
| 14699 | file-name 'vhdl-speedbar-architecture-selected-face pos) |
| 14700 | pos (vhdl-speedbar-update-units |
| 14701 | "\\[.\\] " (nth 3 file-entry) |
| 14702 | file-name 'vhdl-speedbar-configuration-selected-face pos) |
| 14703 | pos (vhdl-speedbar-update-units |
| 14704 | "[]>] " (nth 4 file-entry) |
| 14705 | file-name 'vhdl-speedbar-package-selected-face pos) |
| 14706 | pos (vhdl-speedbar-update-units |
| 14707 | "\\[.\\].+(" '("body") |
| 14708 | file-name 'vhdl-speedbar-package-selected-face pos) |
| 14709 | pos (vhdl-speedbar-update-units |
| 14710 | "> " (nth 6 file-entry) |
| 14711 | file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) |
| 14712 | ;; move speedbar so the first highlighted unit is visible |
| 14713 | (when (and pos (not no-position)) |
| 14714 | (goto-char pos) |
| 14715 | (speedbar-center-buffer-smartly) |
| 14716 | (speedbar-position-cursor-on-line)) |
| 14717 | (setq speedbar-last-selected-file file-name)) |
| 14718 | (select-frame last-frame) |
| 14719 | t)) |
| 14720 | |
| 14721 | (defun vhdl-speedbar-update-units (text unit-list file-name face |
| 14722 | &optional pos) |
| 14723 | "Help function to highlight design units." |
| 14724 | (while unit-list |
| 14725 | (goto-char (point-min)) |
| 14726 | (while (re-search-forward |
| 14727 | (concat text "\\(" (car unit-list) "\\)\\>") nil t) |
| 14728 | (when (equal file-name (car (get-text-property |
| 14729 | (match-beginning 1) 'speedbar-token))) |
| 14730 | (setq pos (or pos (point-marker))) |
| 14731 | (put-text-property (match-beginning 1) (match-end 1) 'face face))) |
| 14732 | (setq unit-list (cdr unit-list))) |
| 14733 | pos) |
| 14734 | |
| 14735 | (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker |
| 14736 | ent-name ent-file-marker |
| 14737 | arch-name arch-file-marker |
| 14738 | conf-name conf-file-marker |
| 14739 | lib-name depth offset delimiter) |
| 14740 | "Insert instantiation entry." |
| 14741 | (let ((start (point)) |
| 14742 | visible-start) |
| 14743 | (insert (int-to-string depth) ":") |
| 14744 | (put-text-property start (point) 'invisible t) |
| 14745 | (setq visible-start (point)) |
| 14746 | (insert-char ? (* depth speedbar-indentation-width)) |
| 14747 | (while (> offset 0) |
| 14748 | (insert "|") |
| 14749 | (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) |
| 14750 | (setq offset (1- offset))) |
| 14751 | (put-text-property visible-start (point) 'invisible nil) |
| 14752 | (setq start (point)) |
| 14753 | (insert ">") |
| 14754 | (speedbar-make-button start (point) nil nil nil) |
| 14755 | (setq visible-start (point)) |
| 14756 | (insert " ") |
| 14757 | (setq start (point)) |
| 14758 | (if (not inst-name) |
| 14759 | (insert "(top)") |
| 14760 | (insert inst-name) |
| 14761 | (speedbar-make-button |
| 14762 | start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face |
| 14763 | 'vhdl-speedbar-find-file inst-file-marker)) |
| 14764 | (insert delimiter) |
| 14765 | (when ent-name |
| 14766 | (setq start (point)) |
| 14767 | (insert ent-name) |
| 14768 | (speedbar-make-button |
| 14769 | start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face |
| 14770 | 'vhdl-speedbar-find-file ent-file-marker) |
| 14771 | (when arch-name |
| 14772 | (insert " (") |
| 14773 | (setq start (point)) |
| 14774 | (insert arch-name) |
| 14775 | (speedbar-make-button |
| 14776 | start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face |
| 14777 | 'vhdl-speedbar-find-file arch-file-marker) |
| 14778 | (insert ")")) |
| 14779 | (when conf-name |
| 14780 | (insert " (") |
| 14781 | (setq start (point)) |
| 14782 | (insert conf-name) |
| 14783 | (speedbar-make-button |
| 14784 | start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face |
| 14785 | 'vhdl-speedbar-find-file conf-file-marker) |
| 14786 | (insert ")"))) |
| 14787 | (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) |
| 14788 | (setq start (point)) |
| 14789 | (insert " (" lib-name ")") |
| 14790 | (put-text-property (+ 2 start) (1- (point)) 'face |
| 14791 | 'vhdl-speedbar-library-face)) |
| 14792 | (insert-char ?\n 1) |
| 14793 | (put-text-property visible-start (point) 'invisible nil))) |
| 14794 | |
| 14795 | (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker |
| 14796 | body-file-marker depth) |
| 14797 | "Insert package entry." |
| 14798 | (let ((start (point)) |
| 14799 | visible-start) |
| 14800 | (insert (int-to-string depth) ":") |
| 14801 | (put-text-property start (point) 'invisible t) |
| 14802 | (setq visible-start (point)) |
| 14803 | (insert-char ? (* depth speedbar-indentation-width)) |
| 14804 | (put-text-property visible-start (point) 'invisible nil) |
| 14805 | (setq start (point)) |
| 14806 | (insert "[+]") |
| 14807 | (speedbar-make-button |
| 14808 | start (point) 'speedbar-button-face 'speedbar-highlight-face |
| 14809 | 'vhdl-speedbar-expand-package pack-key) |
| 14810 | (setq visible-start (point)) |
| 14811 | (insert-char ? 1 nil) |
| 14812 | (setq start (point)) |
| 14813 | (insert pack-name) |
| 14814 | (speedbar-make-button |
| 14815 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 14816 | 'vhdl-speedbar-find-file pack-file-marker) |
| 14817 | (unless (car pack-file-marker) |
| 14818 | (insert "!")) |
| 14819 | (when (car body-file-marker) |
| 14820 | (insert " (") |
| 14821 | (setq start (point)) |
| 14822 | (insert "body") |
| 14823 | (speedbar-make-button |
| 14824 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 14825 | 'vhdl-speedbar-find-file body-file-marker) |
| 14826 | (insert ")")) |
| 14827 | (insert-char ?\n 1) |
| 14828 | (put-text-property visible-start (point) 'invisible nil))) |
| 14829 | |
| 14830 | (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker |
| 14831 | pack-body-file-marker depth) |
| 14832 | "Insert used package entry." |
| 14833 | (let ((start (point)) |
| 14834 | visible-start) |
| 14835 | (insert (int-to-string depth) ":") |
| 14836 | (put-text-property start (point) 'invisible t) |
| 14837 | (setq visible-start (point)) |
| 14838 | (insert-char ? (* depth speedbar-indentation-width)) |
| 14839 | (put-text-property visible-start (point) 'invisible nil) |
| 14840 | (setq start (point)) |
| 14841 | (insert ">") |
| 14842 | (speedbar-make-button start (point) nil nil nil) |
| 14843 | (setq visible-start (point)) |
| 14844 | (insert " ") |
| 14845 | (setq start (point)) |
| 14846 | (insert pack-name) |
| 14847 | (speedbar-make-button |
| 14848 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 14849 | 'vhdl-speedbar-find-file pack-file-marker) |
| 14850 | (when (car pack-body-file-marker) |
| 14851 | (insert " (") |
| 14852 | (setq start (point)) |
| 14853 | (insert "body") |
| 14854 | (speedbar-make-button |
| 14855 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 14856 | 'vhdl-speedbar-find-file pack-body-file-marker) |
| 14857 | (insert ")")) |
| 14858 | (setq start (point)) |
| 14859 | (insert " (" lib-name ")") |
| 14860 | (put-text-property (+ 2 start) (1- (point)) 'face |
| 14861 | 'vhdl-speedbar-library-face) |
| 14862 | (insert-char ?\n 1) |
| 14863 | (put-text-property visible-start (point) 'invisible nil))) |
| 14864 | |
| 14865 | (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker |
| 14866 | func-body-file-marker |
| 14867 | depth) |
| 14868 | "Insert subprogram entry." |
| 14869 | (let ((start (point)) |
| 14870 | visible-start) |
| 14871 | (insert (int-to-string depth) ":") |
| 14872 | (put-text-property start (point) 'invisible t) |
| 14873 | (setq visible-start (point)) |
| 14874 | (insert-char ? (* depth speedbar-indentation-width)) |
| 14875 | (put-text-property visible-start (point) 'invisible nil) |
| 14876 | (setq start (point)) |
| 14877 | (insert ">") |
| 14878 | (speedbar-make-button start (point) nil nil nil) |
| 14879 | (setq visible-start (point)) |
| 14880 | (insert " ") |
| 14881 | (setq start (point)) |
| 14882 | (insert func-name) |
| 14883 | (speedbar-make-button |
| 14884 | start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face |
| 14885 | 'vhdl-speedbar-find-file func-file-marker) |
| 14886 | (when (car func-body-file-marker) |
| 14887 | (insert " (") |
| 14888 | (setq start (point)) |
| 14889 | (insert "body") |
| 14890 | (speedbar-make-button |
| 14891 | start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face |
| 14892 | 'vhdl-speedbar-find-file func-body-file-marker) |
| 14893 | (insert ")")) |
| 14894 | (insert-char ?\n 1) |
| 14895 | (put-text-property visible-start (point) 'invisible nil))) |
| 14896 | |
| 14897 | (defun vhdl-speedbar-make-title-line (text &optional depth) |
| 14898 | "Insert design unit title entry." |
| 14899 | (let ((start (point)) |
| 14900 | visible-start) |
| 14901 | (when depth |
| 14902 | (insert (int-to-string depth) ":") |
| 14903 | (put-text-property start (point) 'invisible t)) |
| 14904 | (setq visible-start (point)) |
| 14905 | (insert-char ? (* (or depth 0) speedbar-indentation-width)) |
| 14906 | (setq start (point)) |
| 14907 | (insert text) |
| 14908 | (speedbar-make-button start (point) nil nil nil nil) |
| 14909 | (insert-char ?\n 1) |
| 14910 | (put-text-property visible-start (point) 'invisible nil))) |
| 14911 | |
| 14912 | (defun vhdl-speedbar-insert-dirs (files level) |
| 14913 | "Insert subdirectories." |
| 14914 | (let ((dirs (car files))) |
| 14915 | (while dirs |
| 14916 | (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) |
| 14917 | (car dirs) 'speedbar-dir-follow nil |
| 14918 | 'speedbar-directory-face level) |
| 14919 | (setq dirs (cdr dirs))))) |
| 14920 | |
| 14921 | (defun vhdl-speedbar-dired (text token indent) |
| 14922 | "Speedbar click handler for directory expand button in hierarchy mode." |
| 14923 | (cond ((string-match "+" text) ; we have to expand this dir |
| 14924 | (setq speedbar-shown-directories |
| 14925 | (cons (expand-file-name |
| 14926 | (concat (speedbar-line-directory indent) token "/")) |
| 14927 | speedbar-shown-directories)) |
| 14928 | (speedbar-change-expand-button-char ?-) |
| 14929 | (speedbar-reset-scanners) |
| 14930 | (speedbar-with-writable |
| 14931 | (save-excursion |
| 14932 | (end-of-line) (forward-char 1) |
| 14933 | (vhdl-speedbar-insert-dirs |
| 14934 | (speedbar-file-lists |
| 14935 | (concat (speedbar-line-directory indent) token "/")) |
| 14936 | (1+ indent)) |
| 14937 | (speedbar-reset-scanners) |
| 14938 | (vhdl-speedbar-insert-dir-hierarchy |
| 14939 | (abbreviate-file-name |
| 14940 | (concat (speedbar-line-directory indent) token "/")) |
| 14941 | (1+ indent) speedbar-power-click))) |
| 14942 | (vhdl-speedbar-update-current-unit t t)) |
| 14943 | ((string-match "-" text) ; we have to contract this node |
| 14944 | (speedbar-reset-scanners) |
| 14945 | (let ((oldl speedbar-shown-directories) |
| 14946 | (newl nil) |
| 14947 | (td (expand-file-name |
| 14948 | (concat (speedbar-line-directory indent) token)))) |
| 14949 | (while oldl |
| 14950 | (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) |
| 14951 | (setq newl (cons (car oldl) newl))) |
| 14952 | (setq oldl (cdr oldl))) |
| 14953 | (setq speedbar-shown-directories (nreverse newl))) |
| 14954 | (speedbar-change-expand-button-char ?+) |
| 14955 | (speedbar-delete-subblock indent)) |
| 14956 | (t (error "Nothing to display"))) |
| 14957 | (when (equal (selected-frame) speedbar-frame) |
| 14958 | (speedbar-center-buffer-smartly))) |
| 14959 | |
| 14960 | (defun vhdl-speedbar-item-info () |
| 14961 | "Derive and display information about this line item." |
| 14962 | (save-excursion |
| 14963 | (beginning-of-line) |
| 14964 | ;; skip invisible number info |
| 14965 | (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) |
| 14966 | (cond |
| 14967 | ;; project/directory entry |
| 14968 | ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") |
| 14969 | (if vhdl-speedbar-show-projects |
| 14970 | (message "Project \"%s\"" (match-string-no-properties 1)) |
| 14971 | (speedbar-files-item-info))) |
| 14972 | ;; design unit entry |
| 14973 | ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") |
| 14974 | (goto-char (match-end 1)) |
| 14975 | (let ((face (get-text-property (point) 'face))) |
| 14976 | (message |
| 14977 | "%s \"%s\" in \"%s\"" |
| 14978 | ;; design unit kind |
| 14979 | (cond ((or (eq face 'vhdl-speedbar-entity-face) |
| 14980 | (eq face 'vhdl-speedbar-entity-selected-face)) |
| 14981 | (if (equal (match-string 2) ">") "Component" "Entity")) |
| 14982 | ((or (eq face 'vhdl-speedbar-architecture-face) |
| 14983 | (eq face 'vhdl-speedbar-architecture-selected-face)) |
| 14984 | "Architecture") |
| 14985 | ((or (eq face 'vhdl-speedbar-configuration-face) |
| 14986 | (eq face 'vhdl-speedbar-configuration-selected-face)) |
| 14987 | "Configuration") |
| 14988 | ((or (eq face 'vhdl-speedbar-package-face) |
| 14989 | (eq face 'vhdl-speedbar-package-selected-face)) |
| 14990 | "Package") |
| 14991 | ((or (eq face 'vhdl-speedbar-instantiation-face) |
| 14992 | (eq face 'vhdl-speedbar-instantiation-selected-face)) |
| 14993 | "Instantiation") |
| 14994 | ((eq face 'vhdl-speedbar-subprogram-face) |
| 14995 | "Subprogram") |
| 14996 | (t "")) |
| 14997 | ;; design unit name |
| 14998 | (buffer-substring-no-properties |
| 14999 | (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) |
| 15000 | (match-end 1)) |
| 15001 | ;; file name |
| 15002 | (file-relative-name |
| 15003 | (or (car (get-text-property (point) 'speedbar-token)) |
| 15004 | "?") |
| 15005 | (vhdl-default-directory))))) |
| 15006 | (t (message ""))))) |
| 15007 | |
| 15008 | (defun vhdl-speedbar-line-text () |
| 15009 | "Calls `speedbar-line-text' and removes text properties." |
| 15010 | (let ((string (speedbar-line-text))) |
| 15011 | (set-text-properties 0 (length string) nil string) |
| 15012 | string)) |
| 15013 | |
| 15014 | (defun vhdl-speedbar-higher-text () |
| 15015 | "Get speedbar-line-text of higher level." |
| 15016 | (let (depth string) |
| 15017 | (save-excursion |
| 15018 | (beginning-of-line) |
| 15019 | (looking-at "^\\([0-9]+\\):") |
| 15020 | (setq depth (string-to-number (match-string 1))) |
| 15021 | (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) |
| 15022 | (setq string (match-string 1)) |
| 15023 | (set-text-properties 0 (length string) nil string) |
| 15024 | string)))) |
| 15025 | |
| 15026 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15027 | ;; Help functions |
| 15028 | |
| 15029 | (defun vhdl-speedbar-line-key (&optional indent) |
| 15030 | "Get currently displayed directory of project name." |
| 15031 | (if vhdl-speedbar-show-projects |
| 15032 | (vhdl-speedbar-line-project) |
| 15033 | (abbreviate-file-name |
| 15034 | (file-name-as-directory (speedbar-line-directory indent))))) |
| 15035 | |
| 15036 | (defun vhdl-speedbar-line-project (&optional indent) |
| 15037 | "Get currently displayed project name." |
| 15038 | (and vhdl-speedbar-show-projects |
| 15039 | (save-excursion |
| 15040 | (end-of-line) |
| 15041 | (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) |
| 15042 | (match-string-no-properties 1)))) |
| 15043 | |
| 15044 | (defun vhdl-add-modified-file () |
| 15045 | "Add file to `vhdl-modified-file-list'." |
| 15046 | (when vhdl-file-alist |
| 15047 | (add-to-list 'vhdl-modified-file-list (buffer-file-name))) |
| 15048 | nil) |
| 15049 | |
| 15050 | (defun vhdl-resolve-paths (path-list) |
| 15051 | "Resolve path wildcards in PATH-LIST." |
| 15052 | (let (path-list-1 path-list-2 path-beg path-end dir) |
| 15053 | ;; eliminate non-existent directories |
| 15054 | (while path-list |
| 15055 | (setq dir (car path-list)) |
| 15056 | (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) |
| 15057 | (if (file-directory-p (match-string 2 dir)) |
| 15058 | (setq path-list-1 (cons dir path-list-1)) |
| 15059 | (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) |
| 15060 | (setq path-list (cdr path-list))) |
| 15061 | ;; resolve path wildcards |
| 15062 | (while path-list-1 |
| 15063 | (setq dir (car path-list-1)) |
| 15064 | (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) |
| 15065 | (progn |
| 15066 | (setq path-beg (match-string 1 dir) |
| 15067 | path-end (match-string 5 dir)) |
| 15068 | (setq path-list-1 |
| 15069 | (append |
| 15070 | (mapcar |
| 15071 | (function |
| 15072 | (lambda (var) (concat path-beg var path-end))) |
| 15073 | (let ((all-list (vhdl-directory-files |
| 15074 | (match-string 2 dir) t |
| 15075 | (concat "\\<" (wildcard-to-regexp |
| 15076 | (match-string 4 dir))))) |
| 15077 | dir-list) |
| 15078 | (while all-list |
| 15079 | (when (file-directory-p (car all-list)) |
| 15080 | (setq dir-list (cons (car all-list) dir-list))) |
| 15081 | (setq all-list (cdr all-list))) |
| 15082 | dir-list)) |
| 15083 | (cdr path-list-1)))) |
| 15084 | (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) |
| 15085 | (when (file-directory-p (match-string 2 dir)) |
| 15086 | (setq path-list-2 (cons dir path-list-2))) |
| 15087 | (setq path-list-1 (cdr path-list-1)))) |
| 15088 | (nreverse path-list-2))) |
| 15089 | |
| 15090 | (defun vhdl-speedbar-goto-this-unit (directory unit) |
| 15091 | "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." |
| 15092 | (let ((dest (point))) |
| 15093 | (if (and (if vhdl-speedbar-show-projects |
| 15094 | (progn (goto-char (point-min)) t) |
| 15095 | (speedbar-goto-this-file directory)) |
| 15096 | (re-search-forward (concat "[]}] " unit "\\>") nil t)) |
| 15097 | (progn (speedbar-position-cursor-on-line) |
| 15098 | t) |
| 15099 | (goto-char dest) |
| 15100 | nil))) |
| 15101 | |
| 15102 | (defun vhdl-speedbar-find-file (text token indent) |
| 15103 | "When user clicks on TEXT, load file with name and position in TOKEN. |
| 15104 | Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file |
| 15105 | is already shown in a buffer." |
| 15106 | (if (not (car token)) |
| 15107 | (error "ERROR: File cannot be found") |
| 15108 | (let ((buffer (get-file-buffer (car token)))) |
| 15109 | (speedbar-find-file-in-frame (car token)) |
| 15110 | (when (or vhdl-speedbar-jump-to-unit buffer) |
| 15111 | (goto-char (point-min)) |
| 15112 | (forward-line (1- (cdr token))) |
| 15113 | (recenter)) |
| 15114 | (vhdl-speedbar-update-current-unit t t) |
| 15115 | (speedbar-set-timer dframe-update-speed) |
| 15116 | (speedbar-maybee-jump-to-attached-frame)))) |
| 15117 | |
| 15118 | (defun vhdl-speedbar-port-copy () |
| 15119 | "Copy the port of the entity/component or subprogram under the cursor." |
| 15120 | (interactive) |
| 15121 | (let ((is-entity (vhdl-speedbar-check-unit 'entity))) |
| 15122 | (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) |
| 15123 | (error "ERROR: No entity/component or subprogram under cursor") |
| 15124 | (beginning-of-line) |
| 15125 | (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") |
| 15126 | (condition-case info |
| 15127 | (let ((token (get-text-property |
| 15128 | (match-beginning 3) 'speedbar-token))) |
| 15129 | (vhdl-visit-file (car token) t |
| 15130 | (progn (goto-char (point-min)) |
| 15131 | (forward-line (1- (cdr token))) |
| 15132 | (end-of-line) |
| 15133 | (if is-entity |
| 15134 | (vhdl-port-copy) |
| 15135 | (vhdl-subprog-copy))))) |
| 15136 | (error (error "ERROR: %s not scanned successfully\n (%s)" |
| 15137 | (if is-entity "Port" "Interface") (cadr info)))) |
| 15138 | (error "ERROR: No entity/component or subprogram on current line"))))) |
| 15139 | |
| 15140 | (defun vhdl-speedbar-place-component () |
| 15141 | "Place the entity/component under the cursor as component." |
| 15142 | (interactive) |
| 15143 | (if (not (vhdl-speedbar-check-unit 'entity)) |
| 15144 | (error "ERROR: No entity/component under cursor") |
| 15145 | (vhdl-speedbar-port-copy) |
| 15146 | (if (fboundp 'speedbar-select-attached-frame) |
| 15147 | (speedbar-select-attached-frame) |
| 15148 | (select-frame speedbar-attached-frame)) |
| 15149 | (vhdl-compose-place-component) |
| 15150 | (select-frame speedbar-frame))) |
| 15151 | |
| 15152 | (defun vhdl-speedbar-configuration () |
| 15153 | "Generate configuration for the architecture under the cursor." |
| 15154 | (interactive) |
| 15155 | (if (not (vhdl-speedbar-check-unit 'architecture)) |
| 15156 | (error "ERROR: No architecture under cursor") |
| 15157 | (let ((arch-name (vhdl-speedbar-line-text)) |
| 15158 | (ent-name (vhdl-speedbar-higher-text))) |
| 15159 | (if (fboundp 'speedbar-select-attached-frame) |
| 15160 | (speedbar-select-attached-frame) |
| 15161 | (select-frame speedbar-attached-frame)) |
| 15162 | (vhdl-compose-configuration ent-name arch-name)))) |
| 15163 | |
| 15164 | (defun vhdl-speedbar-select-mra () |
| 15165 | "Select the architecture under the cursor as MRA." |
| 15166 | (interactive) |
| 15167 | (if (not (vhdl-speedbar-check-unit 'architecture)) |
| 15168 | (error "ERROR: No architecture under cursor") |
| 15169 | (let* ((arch-key (downcase (vhdl-speedbar-line-text))) |
| 15170 | (ent-key (downcase (vhdl-speedbar-higher-text))) |
| 15171 | (ent-alist (aget vhdl-entity-alist |
| 15172 | (or (vhdl-project-p) default-directory) t)) |
| 15173 | (ent-entry (aget ent-alist ent-key t))) |
| 15174 | (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) |
| 15175 | (speedbar-refresh)))) |
| 15176 | |
| 15177 | (defun vhdl-speedbar-make-design () |
| 15178 | "Make (compile) design unit or directory/project under the cursor." |
| 15179 | (interactive) |
| 15180 | (if (not (save-excursion (beginning-of-line) |
| 15181 | (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) |
| 15182 | (error "ERROR: No primary design unit or directory/project under cursor") |
| 15183 | (let ((is-unit (match-string 2)) |
| 15184 | (unit-name (vhdl-speedbar-line-text)) |
| 15185 | (vhdl-project (vhdl-speedbar-line-project)) |
| 15186 | (directory (file-name-as-directory |
| 15187 | (or (speedbar-line-file) (speedbar-line-directory))))) |
| 15188 | (if (fboundp 'speedbar-select-attached-frame) |
| 15189 | (speedbar-select-attached-frame) |
| 15190 | (select-frame speedbar-attached-frame)) |
| 15191 | (let ((default-directory directory)) |
| 15192 | (vhdl-make (and is-unit unit-name)))))) |
| 15193 | |
| 15194 | (defun vhdl-speedbar-generate-makefile () |
| 15195 | "Generate Makefile for directory/project under the cursor." |
| 15196 | (interactive) |
| 15197 | (let ((vhdl-project (vhdl-speedbar-line-project)) |
| 15198 | (default-directory (file-name-as-directory |
| 15199 | (or (speedbar-line-file) (speedbar-line-directory))))) |
| 15200 | (vhdl-generate-makefile))) |
| 15201 | |
| 15202 | (defun vhdl-speedbar-check-unit (design-unit) |
| 15203 | "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its |
| 15204 | expansion function)." |
| 15205 | (save-excursion |
| 15206 | (speedbar-position-cursor-on-line) |
| 15207 | (cond ((eq design-unit 'entity) |
| 15208 | (memq (get-text-property (match-end 0) 'face) |
| 15209 | '(vhdl-speedbar-entity-face |
| 15210 | vhdl-speedbar-entity-selected-face))) |
| 15211 | ((eq design-unit 'architecture) |
| 15212 | (memq (get-text-property (match-end 0) 'face) |
| 15213 | '(vhdl-speedbar-architecture-face |
| 15214 | vhdl-speedbar-architecture-selected-face))) |
| 15215 | ((eq design-unit 'subprogram) |
| 15216 | (eq (get-text-property (match-end 0) 'face) |
| 15217 | 'vhdl-speedbar-subprogram-face)) |
| 15218 | (t nil)))) |
| 15219 | |
| 15220 | (defun vhdl-speedbar-set-depth (depth) |
| 15221 | "Set hierarchy display depth to DEPTH and refresh speedbar." |
| 15222 | (setq vhdl-speedbar-hierarchy-depth depth) |
| 15223 | (speedbar-refresh)) |
| 15224 | |
| 15225 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15226 | ;; Fontification |
| 15227 | |
| 15228 | (defface vhdl-speedbar-entity-face |
| 15229 | '((((class color) (background light)) (:foreground "ForestGreen")) |
| 15230 | (((class color) (background dark)) (:foreground "PaleGreen"))) |
| 15231 | "Face used for displaying entity names." |
| 15232 | :group 'speedbar-faces) |
| 15233 | |
| 15234 | (defface vhdl-speedbar-architecture-face |
| 15235 | '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) |
| 15236 | (((class color) (background light)) (:foreground "Blue")) |
| 15237 | |
| 15238 | (((class color) (background dark)) (:foreground "LightSkyBlue"))) |
| 15239 | "Face used for displaying architecture names." |
| 15240 | :group 'speedbar-faces) |
| 15241 | |
| 15242 | (defface vhdl-speedbar-configuration-face |
| 15243 | '((((class color) (background light)) (:foreground "DarkGoldenrod")) |
| 15244 | (((class color) (background dark)) (:foreground "Salmon"))) |
| 15245 | "Face used for displaying configuration names." |
| 15246 | :group 'speedbar-faces) |
| 15247 | |
| 15248 | (defface vhdl-speedbar-package-face |
| 15249 | '((((class color) (background light)) (:foreground "Grey50")) |
| 15250 | (((class color) (background dark)) (:foreground "Grey80"))) |
| 15251 | "Face used for displaying package names." |
| 15252 | :group 'speedbar-faces) |
| 15253 | |
| 15254 | (defface vhdl-speedbar-library-face |
| 15255 | '((((class color) (background light)) (:foreground "Purple")) |
| 15256 | (((class color) (background dark)) (:foreground "Orchid1"))) |
| 15257 | "Face used for displaying library names." |
| 15258 | :group 'speedbar-faces) |
| 15259 | |
| 15260 | (defface vhdl-speedbar-instantiation-face |
| 15261 | '((((class color) (background light)) (:foreground "Brown")) |
| 15262 | (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) |
| 15263 | (((class color) (background dark)) (:foreground "Yellow"))) |
| 15264 | "Face used for displaying instantiation names." |
| 15265 | :group 'speedbar-faces) |
| 15266 | |
| 15267 | (defface vhdl-speedbar-subprogram-face |
| 15268 | '((((class color) (background light)) (:foreground "Orchid4")) |
| 15269 | (((class color) (background dark)) (:foreground "BurlyWood2"))) |
| 15270 | "Face used for displaying subprogram names." |
| 15271 | :group 'speedbar-faces) |
| 15272 | |
| 15273 | (defface vhdl-speedbar-entity-selected-face |
| 15274 | '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) |
| 15275 | (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) |
| 15276 | "Face used for displaying entity names." |
| 15277 | :group 'speedbar-faces) |
| 15278 | |
| 15279 | (defface vhdl-speedbar-architecture-selected-face |
| 15280 | '((((min-colors 88) (class color) (background light)) (:foreground |
| 15281 | "Blue1" :underline t)) |
| 15282 | (((class color) (background light)) (:foreground "Blue" :underline t)) |
| 15283 | (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) |
| 15284 | "Face used for displaying architecture names." |
| 15285 | :group 'speedbar-faces) |
| 15286 | |
| 15287 | (defface vhdl-speedbar-configuration-selected-face |
| 15288 | '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) |
| 15289 | (((class color) (background dark)) (:foreground "Salmon" :underline t))) |
| 15290 | "Face used for displaying configuration names." |
| 15291 | :group 'speedbar-faces) |
| 15292 | |
| 15293 | (defface vhdl-speedbar-package-selected-face |
| 15294 | '((((class color) (background light)) (:foreground "Grey50" :underline t)) |
| 15295 | (((class color) (background dark)) (:foreground "Grey80" :underline t))) |
| 15296 | "Face used for displaying package names." |
| 15297 | :group 'speedbar-faces) |
| 15298 | |
| 15299 | (defface vhdl-speedbar-instantiation-selected-face |
| 15300 | '((((class color) (background light)) (:foreground "Brown" :underline t)) |
| 15301 | (((class color) (background dark)) (:foreground "Yellow" :underline t))) |
| 15302 | "Face used for displaying instantiation names." |
| 15303 | :group 'speedbar-faces) |
| 15304 | |
| 15305 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15306 | ;; Initialization |
| 15307 | |
| 15308 | ;; add speedbar |
| 15309 | (when (fboundp 'speedbar) |
| 15310 | (condition-case () |
| 15311 | (when (and vhdl-speedbar-auto-open |
| 15312 | (not (and (boundp 'speedbar-frame) |
| 15313 | (frame-live-p speedbar-frame)))) |
| 15314 | (speedbar-frame-mode 1) |
| 15315 | (if (fboundp 'speedbar-select-attached-frame) |
| 15316 | (speedbar-select-attached-frame) |
| 15317 | (select-frame speedbar-attached-frame))) |
| 15318 | (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))) |
| 15319 | |
| 15320 | ;; initialize speedbar |
| 15321 | (if (not (boundp 'speedbar-frame)) |
| 15322 | (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize) |
| 15323 | (vhdl-speedbar-initialize) |
| 15324 | (when speedbar-frame (vhdl-speedbar-refresh))) |
| 15325 | |
| 15326 | |
| 15327 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15328 | ;;; Structural composition |
| 15329 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15330 | |
| 15331 | (defun vhdl-get-components-package-name () |
| 15332 | "Return the name of the components package." |
| 15333 | (let ((project (vhdl-project-p))) |
| 15334 | (if project |
| 15335 | (vhdl-replace-string (car vhdl-components-package-name) |
| 15336 | (subst-char-in-string ? ?_ project)) |
| 15337 | (cdr vhdl-components-package-name)))) |
| 15338 | |
| 15339 | (defun vhdl-compose-new-component () |
| 15340 | "Create entity and architecture for new component." |
| 15341 | (interactive) |
| 15342 | (let* ((case-fold-search t) |
| 15343 | (ent-name (read-from-minibuffer "entity name: " |
| 15344 | nil vhdl-minibuffer-local-map)) |
| 15345 | (arch-name |
| 15346 | (if (equal (cdr vhdl-compose-architecture-name) "") |
| 15347 | (read-from-minibuffer "architecture name: " |
| 15348 | nil vhdl-minibuffer-local-map) |
| 15349 | (vhdl-replace-string vhdl-compose-architecture-name ent-name))) |
| 15350 | ent-file-name arch-file-name ent-buffer arch-buffer project) |
| 15351 | (message "Creating component \"%s(%s)\"..." ent-name arch-name) |
| 15352 | ;; open entity file |
| 15353 | (unless (eq vhdl-compose-create-files 'none) |
| 15354 | (setq ent-file-name |
| 15355 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 15356 | "." (file-name-extension (buffer-file-name)))) |
| 15357 | (when (and (file-exists-p ent-file-name) |
| 15358 | (not (y-or-n-p (concat "File \"" ent-file-name |
| 15359 | "\" exists; overwrite? ")))) |
| 15360 | (error "ERROR: Creating component...aborted")) |
| 15361 | (find-file ent-file-name) |
| 15362 | (erase-buffer) |
| 15363 | (set-buffer-modified-p nil)) |
| 15364 | ;; insert header |
| 15365 | (if vhdl-compose-include-header |
| 15366 | (progn (vhdl-template-header) |
| 15367 | (goto-char (point-max))) |
| 15368 | (vhdl-comment-display-line) (insert "\n\n")) |
| 15369 | ;; insert library clause |
| 15370 | (vhdl-template-package-std-logic-1164) |
| 15371 | (when vhdl-use-components-package |
| 15372 | (insert "\n") |
| 15373 | (vhdl-template-standard-package (vhdl-work-library) |
| 15374 | (vhdl-get-components-package-name))) |
| 15375 | (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") |
| 15376 | ;; insert entity declaration |
| 15377 | (vhdl-insert-keyword "ENTITY ") (insert ent-name) |
| 15378 | (vhdl-insert-keyword " IS\n") |
| 15379 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 15380 | (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") |
| 15381 | (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") |
| 15382 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 15383 | (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") |
| 15384 | (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") |
| 15385 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 15386 | (vhdl-insert-keyword "END ") |
| 15387 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 15388 | (insert ent-name ";\n\n") |
| 15389 | (vhdl-comment-display-line) (insert "\n") |
| 15390 | ;; open architecture file |
| 15391 | (if (not (eq vhdl-compose-create-files 'separate)) |
| 15392 | (insert "\n") |
| 15393 | (setq ent-buffer (current-buffer)) |
| 15394 | (setq arch-file-name |
| 15395 | (concat (vhdl-replace-string vhdl-architecture-file-name |
| 15396 | (concat ent-name " " arch-name) t) |
| 15397 | "." (file-name-extension (buffer-file-name)))) |
| 15398 | (when (and (file-exists-p arch-file-name) |
| 15399 | (not (y-or-n-p (concat "File \"" arch-file-name |
| 15400 | "\" exists; overwrite? ")))) |
| 15401 | (error "ERROR: Creating component...aborted")) |
| 15402 | (find-file arch-file-name) |
| 15403 | (erase-buffer) |
| 15404 | (set-buffer-modified-p nil) |
| 15405 | ;; insert header |
| 15406 | (if vhdl-compose-include-header |
| 15407 | (progn (vhdl-template-header) |
| 15408 | (goto-char (point-max))) |
| 15409 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 15410 | ;; insert architecture body |
| 15411 | (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) |
| 15412 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 15413 | (vhdl-insert-keyword " IS\n\n") |
| 15414 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 15415 | (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") |
| 15416 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 15417 | (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) |
| 15418 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 15419 | (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") |
| 15420 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) |
| 15421 | (vhdl-insert-keyword "BEGIN") |
| 15422 | (when vhdl-self-insert-comments |
| 15423 | (insert " -- ") |
| 15424 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) |
| 15425 | (insert arch-name)) |
| 15426 | (insert "\n\n") |
| 15427 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 15428 | (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") |
| 15429 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 15430 | (vhdl-insert-keyword "END ") |
| 15431 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) |
| 15432 | (insert arch-name ";\n\n") |
| 15433 | ;; insert footer and save |
| 15434 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 15435 | (vhdl-template-footer) |
| 15436 | (vhdl-comment-display-line) (insert "\n")) |
| 15437 | (goto-char (point-min)) |
| 15438 | (setq arch-buffer (current-buffer)) |
| 15439 | (when ent-buffer (set-buffer ent-buffer) (save-buffer)) |
| 15440 | (set-buffer arch-buffer) (save-buffer) |
| 15441 | (message "%s" |
| 15442 | (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) |
| 15443 | (and ent-file-name |
| 15444 | (format "\n File created: \"%s\"" ent-file-name)) |
| 15445 | (and arch-file-name |
| 15446 | (format "\n File created: \"%s\"" arch-file-name)))))) |
| 15447 | |
| 15448 | (defun vhdl-compose-place-component () |
| 15449 | "Place new component by pasting current port as component declaration and |
| 15450 | component instantiation." |
| 15451 | (interactive) |
| 15452 | (if (not vhdl-port-list) |
| 15453 | (error "ERROR: No port has been read") |
| 15454 | (save-excursion |
| 15455 | (vhdl-prepare-search-2 |
| 15456 | (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 15457 | (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)) |
| 15458 | (error "ERROR: No architecture found")) |
| 15459 | (let* ((ent-name (match-string 1)) |
| 15460 | (ent-file-name |
| 15461 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 15462 | "." (file-name-extension (buffer-file-name)))) |
| 15463 | (orig-buffer (current-buffer))) |
| 15464 | (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) |
| 15465 | ;; place component declaration |
| 15466 | (unless (or vhdl-use-components-package |
| 15467 | (vhdl-use-direct-instantiation) |
| 15468 | (save-excursion |
| 15469 | (re-search-forward |
| 15470 | (concat "^\\s-*component\\s-+" |
| 15471 | (car vhdl-port-list) "\\>") nil t))) |
| 15472 | (re-search-forward "^begin\\>" nil) |
| 15473 | (beginning-of-line) |
| 15474 | (skip-chars-backward " \t\n") |
| 15475 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 15476 | (vhdl-port-paste-component t)) |
| 15477 | ;; place component instantiation |
| 15478 | (re-search-forward "^end\\>" nil) |
| 15479 | (beginning-of-line) |
| 15480 | (skip-chars-backward " \t\n") |
| 15481 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 15482 | (vhdl-port-paste-instance nil t t) |
| 15483 | ;; place use clause for used packages |
| 15484 | (when (nth 3 vhdl-port-list) |
| 15485 | ;; open entity file |
| 15486 | (when (file-exists-p ent-file-name) |
| 15487 | (find-file ent-file-name)) |
| 15488 | (goto-char (point-min)) |
| 15489 | (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t) |
| 15490 | (error "ERROR: Entity not found: \"%s\"" ent-name)) |
| 15491 | (goto-char (match-beginning 0)) |
| 15492 | (if (and (save-excursion |
| 15493 | (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) |
| 15494 | (match-string 1)) |
| 15495 | (progn (goto-char (match-end 0)) |
| 15496 | (beginning-of-line 2)) |
| 15497 | (insert "\n") |
| 15498 | (backward-char)) |
| 15499 | (vhdl-port-paste-context-clause) |
| 15500 | (switch-to-buffer orig-buffer)) |
| 15501 | (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) |
| 15502 | |
| 15503 | (defun vhdl-compose-wire-components () |
| 15504 | "Connect components." |
| 15505 | (interactive) |
| 15506 | (save-excursion |
| 15507 | (vhdl-prepare-search-2 |
| 15508 | (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) |
| 15509 | (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)) |
| 15510 | (error "ERROR: No architecture found")) |
| 15511 | (let* ((ent-name (match-string 1)) |
| 15512 | (ent-file-name |
| 15513 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 15514 | "." (file-name-extension (buffer-file-name)))) |
| 15515 | (arch-decl-pos (point-marker)) |
| 15516 | (arch-stat-pos (re-search-forward "^begin\\>" nil)) |
| 15517 | (arch-end-pos (re-search-forward "^end\\>" nil)) |
| 15518 | (pack-name (vhdl-get-components-package-name)) |
| 15519 | (pack-file-name |
| 15520 | (concat (vhdl-replace-string vhdl-package-file-name pack-name t) |
| 15521 | "." (file-name-extension (buffer-file-name)))) |
| 15522 | inst-name comp-name comp-ent-name comp-ent-file-name has-generic |
| 15523 | port-alist generic-alist inst-alist |
| 15524 | signal-name signal-entry signal-alist local-list written-list |
| 15525 | single-in-list multi-in-list single-out-list multi-out-list |
| 15526 | constant-name constant-entry constant-alist single-list multi-list |
| 15527 | port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos |
| 15528 | generic-beg-pos generic-pos generic-inst-pos generic-end-pos |
| 15529 | signal-beg-pos signal-pos |
| 15530 | constant-temp-pos port-temp-pos signal-temp-pos) |
| 15531 | (message "Wiring components...") |
| 15532 | ;; process all instances |
| 15533 | (goto-char arch-stat-pos) |
| 15534 | (while (re-search-forward |
| 15535 | (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\(" |
| 15536 | "\\(component[ \t\n]+\\)?\\(\\w+\\)" |
| 15537 | "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|" |
| 15538 | "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?" |
| 15539 | "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t) |
| 15540 | (setq inst-name (match-string-no-properties 1) |
| 15541 | comp-name (match-string-no-properties 4) |
| 15542 | comp-ent-name (match-string-no-properties 12) |
| 15543 | has-generic (or (match-string 7) (match-string 17))) |
| 15544 | ;; get port ... |
| 15545 | (if comp-name |
| 15546 | ;; ... from component declaration |
| 15547 | (vhdl-visit-file |
| 15548 | (when vhdl-use-components-package pack-file-name) t |
| 15549 | (save-excursion |
| 15550 | (goto-char (point-min)) |
| 15551 | (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t) |
| 15552 | (error "ERROR: Component declaration not found: \"%s\"" comp-name)) |
| 15553 | (vhdl-port-copy))) |
| 15554 | ;; ... from entity declaration (direct instantiation) |
| 15555 | (setq comp-ent-file-name |
| 15556 | (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) |
| 15557 | "." (file-name-extension (buffer-file-name)))) |
| 15558 | (vhdl-visit-file |
| 15559 | comp-ent-file-name t |
| 15560 | (save-excursion |
| 15561 | (goto-char (point-min)) |
| 15562 | (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t) |
| 15563 | (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) |
| 15564 | (vhdl-port-copy)))) |
| 15565 | (vhdl-port-flatten t) |
| 15566 | (setq generic-alist (nth 1 vhdl-port-list) |
| 15567 | port-alist (nth 2 vhdl-port-list) |
| 15568 | vhdl-port-list nil) |
| 15569 | (setq constant-alist nil |
| 15570 | signal-alist nil) |
| 15571 | (when has-generic |
| 15572 | ;; process all constants in generic map |
| 15573 | (vhdl-forward-syntactic-ws) |
| 15574 | (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t) |
| 15575 | (setq constant-name (match-string-no-properties 3)) |
| 15576 | (setq constant-entry |
| 15577 | (cons constant-name |
| 15578 | (if (match-string 1) |
| 15579 | (or (aget generic-alist (match-string 2) t) |
| 15580 | (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) |
| 15581 | (cdar generic-alist)))) |
| 15582 | (setq constant-alist (cons constant-entry constant-alist)) |
| 15583 | (setq constant-name (downcase constant-name)) |
| 15584 | (if (or (member constant-name single-list) |
| 15585 | (member constant-name multi-list)) |
| 15586 | (progn (setq single-list (delete constant-name single-list)) |
| 15587 | (add-to-list 'multi-list constant-name)) |
| 15588 | (add-to-list 'single-list constant-name)) |
| 15589 | (unless (match-string 1) |
| 15590 | (setq generic-alist (cdr generic-alist))) |
| 15591 | (vhdl-forward-syntactic-ws)) |
| 15592 | (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t)) |
| 15593 | ;; process all signals in port map |
| 15594 | (vhdl-forward-syntactic-ws) |
| 15595 | (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t) |
| 15596 | (setq signal-name (match-string-no-properties 3)) |
| 15597 | (setq signal-entry (cons signal-name |
| 15598 | (if (match-string 1) |
| 15599 | (or (aget port-alist (match-string 2) t) |
| 15600 | (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) |
| 15601 | (cdar port-alist)))) |
| 15602 | (setq signal-alist (cons signal-entry signal-alist)) |
| 15603 | (setq signal-name (downcase signal-name)) |
| 15604 | (if (equal (upcase (nth 2 signal-entry)) "IN") |
| 15605 | ;; input signal |
| 15606 | (cond |
| 15607 | ((member signal-name local-list) |
| 15608 | nil) |
| 15609 | ((or (member signal-name single-out-list) |
| 15610 | (member signal-name multi-out-list)) |
| 15611 | (setq single-out-list (delete signal-name single-out-list)) |
| 15612 | (setq multi-out-list (delete signal-name multi-out-list)) |
| 15613 | (add-to-list 'local-list signal-name)) |
| 15614 | ((member signal-name single-in-list) |
| 15615 | (setq single-in-list (delete signal-name single-in-list)) |
| 15616 | (add-to-list 'multi-in-list signal-name)) |
| 15617 | ((not (member signal-name multi-in-list)) |
| 15618 | (add-to-list 'single-in-list signal-name))) |
| 15619 | ;; output signal |
| 15620 | (cond |
| 15621 | ((member signal-name local-list) |
| 15622 | nil) |
| 15623 | ((or (member signal-name single-in-list) |
| 15624 | (member signal-name multi-in-list)) |
| 15625 | (setq single-in-list (delete signal-name single-in-list)) |
| 15626 | (setq multi-in-list (delete signal-name multi-in-list)) |
| 15627 | (add-to-list 'local-list signal-name)) |
| 15628 | ((member signal-name single-out-list) |
| 15629 | (setq single-out-list (delete signal-name single-out-list)) |
| 15630 | (add-to-list 'multi-out-list signal-name)) |
| 15631 | ((not (member signal-name multi-out-list)) |
| 15632 | (add-to-list 'single-out-list signal-name)))) |
| 15633 | (unless (match-string 1) |
| 15634 | (setq port-alist (cdr port-alist))) |
| 15635 | (vhdl-forward-syntactic-ws)) |
| 15636 | (setq inst-alist (cons (list inst-name (nreverse constant-alist) |
| 15637 | (nreverse signal-alist)) inst-alist))) |
| 15638 | ;; prepare signal insertion |
| 15639 | (vhdl-goto-marker arch-decl-pos) |
| 15640 | (forward-line 1) |
| 15641 | (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t) |
| 15642 | (setq signal-pos (point-marker)) |
| 15643 | (while (progn (vhdl-forward-syntactic-ws) |
| 15644 | (looking-at "signal\\>")) |
| 15645 | (beginning-of-line 2) |
| 15646 | (delete-region signal-pos (point))) |
| 15647 | (setq signal-beg-pos signal-pos) |
| 15648 | ;; open entity file |
| 15649 | (when (file-exists-p ent-file-name) |
| 15650 | (find-file ent-file-name)) |
| 15651 | (goto-char (point-min)) |
| 15652 | (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t) |
| 15653 | (error "ERROR: Entity not found: \"%s\"" ent-name)) |
| 15654 | ;; prepare generic clause insertion |
| 15655 | (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t) |
| 15656 | (match-string 1)) |
| 15657 | (goto-char (match-beginning 0)) |
| 15658 | (indent-to vhdl-basic-offset) |
| 15659 | (insert "generic ();\n\n") |
| 15660 | (backward-char 4)) |
| 15661 | (backward-char) |
| 15662 | (setq generic-pos (point-marker)) |
| 15663 | (forward-sexp) (end-of-line) |
| 15664 | (delete-region generic-pos (point)) (delete-char 1) |
| 15665 | (insert "(\n") |
| 15666 | (when multi-list |
| 15667 | (insert "\n") |
| 15668 | (indent-to (* 2 vhdl-basic-offset)) |
| 15669 | (insert "-- global generics\n")) |
| 15670 | (setq generic-beg-pos (point-marker) generic-pos (point-marker) |
| 15671 | generic-inst-pos (point-marker) generic-end-pos (point-marker)) |
| 15672 | ;; prepare port clause insertion |
| 15673 | (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t) |
| 15674 | (match-string 1)) |
| 15675 | (goto-char (match-beginning 0)) |
| 15676 | (indent-to vhdl-basic-offset) |
| 15677 | (insert "port ();\n\n") |
| 15678 | (backward-char 4)) |
| 15679 | (backward-char) |
| 15680 | (setq port-in-pos (point-marker)) |
| 15681 | (forward-sexp) (end-of-line) |
| 15682 | (delete-region port-in-pos (point)) (delete-char 1) |
| 15683 | (insert "(\n") |
| 15684 | (when (or multi-in-list multi-out-list) |
| 15685 | (insert "\n") |
| 15686 | (indent-to (* 2 vhdl-basic-offset)) |
| 15687 | (insert "-- global ports\n")) |
| 15688 | (setq port-beg-pos (point-marker) port-in-pos (point-marker) |
| 15689 | port-out-pos (point-marker) port-inst-pos (point-marker) |
| 15690 | port-end-pos (point-marker)) |
| 15691 | ;; insert generics, ports and signals |
| 15692 | (setq inst-alist (nreverse inst-alist)) |
| 15693 | (while inst-alist |
| 15694 | (setq inst-name (nth 0 (car inst-alist)) |
| 15695 | constant-alist (nth 1 (car inst-alist)) |
| 15696 | signal-alist (nth 2 (car inst-alist)) |
| 15697 | constant-temp-pos generic-inst-pos |
| 15698 | port-temp-pos port-inst-pos |
| 15699 | signal-temp-pos signal-pos) |
| 15700 | ;; generics |
| 15701 | (while constant-alist |
| 15702 | (setq constant-name (downcase (caar constant-alist)) |
| 15703 | constant-entry (car constant-alist)) |
| 15704 | (cond ((member constant-name written-list) |
| 15705 | nil) |
| 15706 | ((member constant-name multi-list) |
| 15707 | (vhdl-goto-marker generic-pos) |
| 15708 | (setq generic-end-pos |
| 15709 | (vhdl-max-marker |
| 15710 | generic-end-pos |
| 15711 | (vhdl-compose-insert-generic constant-entry))) |
| 15712 | (setq generic-pos (point-marker)) |
| 15713 | (add-to-list 'written-list constant-name)) |
| 15714 | (t |
| 15715 | (vhdl-goto-marker |
| 15716 | (vhdl-max-marker generic-inst-pos generic-pos)) |
| 15717 | (setq generic-end-pos |
| 15718 | (vhdl-compose-insert-generic constant-entry)) |
| 15719 | (setq generic-inst-pos (point-marker)) |
| 15720 | (add-to-list 'written-list constant-name))) |
| 15721 | (setq constant-alist (cdr constant-alist))) |
| 15722 | (when (/= constant-temp-pos generic-inst-pos) |
| 15723 | (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) |
| 15724 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 15725 | (insert "-- generics for \"" inst-name "\"\n") |
| 15726 | (vhdl-goto-marker generic-inst-pos)) |
| 15727 | ;; ports and signals |
| 15728 | (while signal-alist |
| 15729 | (setq signal-name (downcase (caar signal-alist)) |
| 15730 | signal-entry (car signal-alist)) |
| 15731 | (cond ((member signal-name written-list) |
| 15732 | nil) |
| 15733 | ((member signal-name multi-in-list) |
| 15734 | (vhdl-goto-marker port-in-pos) |
| 15735 | (setq port-end-pos |
| 15736 | (vhdl-max-marker |
| 15737 | port-end-pos (vhdl-compose-insert-port signal-entry))) |
| 15738 | (setq port-in-pos (point-marker)) |
| 15739 | (add-to-list 'written-list signal-name)) |
| 15740 | ((member signal-name multi-out-list) |
| 15741 | (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) |
| 15742 | (setq port-end-pos |
| 15743 | (vhdl-max-marker |
| 15744 | port-end-pos (vhdl-compose-insert-port signal-entry))) |
| 15745 | (setq port-out-pos (point-marker)) |
| 15746 | (add-to-list 'written-list signal-name)) |
| 15747 | ((or (member signal-name single-in-list) |
| 15748 | (member signal-name single-out-list)) |
| 15749 | (vhdl-goto-marker |
| 15750 | (vhdl-max-marker |
| 15751 | port-inst-pos |
| 15752 | (vhdl-max-marker port-out-pos port-in-pos))) |
| 15753 | (setq port-end-pos (vhdl-compose-insert-port signal-entry)) |
| 15754 | (setq port-inst-pos (point-marker)) |
| 15755 | (add-to-list 'written-list signal-name)) |
| 15756 | ((equal (upcase (nth 2 signal-entry)) "OUT") |
| 15757 | (vhdl-goto-marker signal-pos) |
| 15758 | (vhdl-compose-insert-signal signal-entry) |
| 15759 | (setq signal-pos (point-marker)) |
| 15760 | (add-to-list 'written-list signal-name))) |
| 15761 | (setq signal-alist (cdr signal-alist))) |
| 15762 | (when (/= port-temp-pos port-inst-pos) |
| 15763 | (vhdl-goto-marker |
| 15764 | (vhdl-max-marker port-temp-pos |
| 15765 | (vhdl-max-marker port-in-pos port-out-pos))) |
| 15766 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 15767 | (insert "-- ports to \"" inst-name "\"\n") |
| 15768 | (vhdl-goto-marker port-inst-pos)) |
| 15769 | (when (/= signal-temp-pos signal-pos) |
| 15770 | (vhdl-goto-marker signal-temp-pos) |
| 15771 | (insert "\n") (indent-to vhdl-basic-offset) |
| 15772 | (insert "-- outputs of \"" inst-name "\"\n") |
| 15773 | (vhdl-goto-marker signal-pos)) |
| 15774 | (setq inst-alist (cdr inst-alist))) |
| 15775 | ;; finalize generic/port clause |
| 15776 | (vhdl-goto-marker generic-end-pos) (backward-char) |
| 15777 | (when (= generic-beg-pos generic-end-pos) |
| 15778 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 15779 | (insert ";") (backward-char)) |
| 15780 | (insert ")") |
| 15781 | (vhdl-goto-marker port-end-pos) (backward-char) |
| 15782 | (when (= port-beg-pos port-end-pos) |
| 15783 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 15784 | (insert ";") (backward-char)) |
| 15785 | (insert ")") |
| 15786 | ;; align everything |
| 15787 | (when vhdl-auto-align |
| 15788 | (vhdl-goto-marker generic-beg-pos) |
| 15789 | (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) |
| 15790 | (vhdl-align-region-groups port-beg-pos port-end-pos 1) |
| 15791 | (vhdl-goto-marker signal-beg-pos) |
| 15792 | (vhdl-align-region-groups signal-beg-pos signal-pos)) |
| 15793 | (switch-to-buffer (marker-buffer signal-beg-pos)) |
| 15794 | (message "Wiring components...done"))))) |
| 15795 | |
| 15796 | (defun vhdl-compose-insert-generic (entry) |
| 15797 | "Insert ENTRY as generic declaration." |
| 15798 | (let (pos) |
| 15799 | (indent-to (* 2 vhdl-basic-offset)) |
| 15800 | (insert (nth 0 entry) " : " (nth 1 entry)) |
| 15801 | (when (nth 2 entry) |
| 15802 | (insert " := " (nth 2 entry))) |
| 15803 | (insert ";") |
| 15804 | (setq pos (point-marker)) |
| 15805 | (when (and vhdl-include-port-comments (nth 3 entry)) |
| 15806 | (vhdl-comment-insert-inline (nth 3 entry) t)) |
| 15807 | (insert "\n") |
| 15808 | pos)) |
| 15809 | |
| 15810 | (defun vhdl-compose-insert-port (entry) |
| 15811 | "Insert ENTRY as port declaration." |
| 15812 | (let (pos) |
| 15813 | (indent-to (* 2 vhdl-basic-offset)) |
| 15814 | (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") |
| 15815 | (setq pos (point-marker)) |
| 15816 | (when (and vhdl-include-port-comments (nth 4 entry)) |
| 15817 | (vhdl-comment-insert-inline (nth 4 entry) t)) |
| 15818 | (insert "\n") |
| 15819 | pos)) |
| 15820 | |
| 15821 | (defun vhdl-compose-insert-signal (entry) |
| 15822 | "Insert ENTRY as signal declaration." |
| 15823 | (indent-to vhdl-basic-offset) |
| 15824 | (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") |
| 15825 | (when (and vhdl-include-port-comments (nth 4 entry)) |
| 15826 | (vhdl-comment-insert-inline (nth 4 entry) t)) |
| 15827 | (insert "\n")) |
| 15828 | |
| 15829 | (defun vhdl-compose-components-package () |
| 15830 | "Generate a package containing component declarations for all entities in the |
| 15831 | current project/directory." |
| 15832 | (interactive) |
| 15833 | (vhdl-require-hierarchy-info) |
| 15834 | (let* ((project (vhdl-project-p)) |
| 15835 | (pack-name (vhdl-get-components-package-name)) |
| 15836 | (pack-file-name |
| 15837 | (concat (vhdl-replace-string vhdl-package-file-name pack-name t) |
| 15838 | "." (file-name-extension (buffer-file-name)))) |
| 15839 | (ent-alist (aget vhdl-entity-alist |
| 15840 | (or project default-directory) t)) |
| 15841 | (lazy-lock-minimum-size 0) |
| 15842 | clause-pos component-pos) |
| 15843 | (message "Generating components package \"%s\"..." pack-name) |
| 15844 | ;; open package file |
| 15845 | (when (and (file-exists-p pack-file-name) |
| 15846 | (not (y-or-n-p (concat "File \"" pack-file-name |
| 15847 | "\" exists; overwrite? ")))) |
| 15848 | (error "ERROR: Generating components package...aborted")) |
| 15849 | (find-file pack-file-name) |
| 15850 | (erase-buffer) |
| 15851 | ;; insert header |
| 15852 | (if vhdl-compose-include-header |
| 15853 | (progn (vhdl-template-header |
| 15854 | (concat "Components package (generated by Emacs VHDL Mode " |
| 15855 | vhdl-version ")")) |
| 15856 | (goto-char (point-max))) |
| 15857 | (vhdl-comment-display-line) (insert "\n\n")) |
| 15858 | ;; insert std_logic_1164 package |
| 15859 | (vhdl-template-package-std-logic-1164) |
| 15860 | (insert "\n") (setq clause-pos (point-marker)) |
| 15861 | (insert "\n") (vhdl-comment-display-line) (insert "\n\n") |
| 15862 | ;; insert package declaration |
| 15863 | (vhdl-insert-keyword "PACKAGE ") (insert pack-name) |
| 15864 | (vhdl-insert-keyword " IS\n\n") |
| 15865 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 15866 | (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") |
| 15867 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 15868 | (indent-to vhdl-basic-offset) |
| 15869 | (setq component-pos (point-marker)) |
| 15870 | (insert "\n\n") (vhdl-insert-keyword "END ") |
| 15871 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) |
| 15872 | (insert pack-name ";\n\n") |
| 15873 | ;; insert footer |
| 15874 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 15875 | (vhdl-template-footer) |
| 15876 | (vhdl-comment-display-line) (insert "\n")) |
| 15877 | ;; insert component declarations |
| 15878 | (while ent-alist |
| 15879 | (vhdl-visit-file (nth 2 (car ent-alist)) nil |
| 15880 | (progn (goto-char (point-min)) |
| 15881 | (forward-line (1- (nth 3 (car ent-alist)))) |
| 15882 | (end-of-line) |
| 15883 | (vhdl-port-copy))) |
| 15884 | (goto-char component-pos) |
| 15885 | (vhdl-port-paste-component t) |
| 15886 | (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 15887 | (setq component-pos (point-marker)) |
| 15888 | (goto-char clause-pos) |
| 15889 | (vhdl-port-paste-context-clause pack-name) |
| 15890 | (setq clause-pos (point-marker)) |
| 15891 | (setq ent-alist (cdr ent-alist))) |
| 15892 | (goto-char (point-min)) |
| 15893 | (save-buffer) |
| 15894 | (message "Generating components package \"%s\"...done\n File created: \"%s\"" |
| 15895 | pack-name pack-file-name))) |
| 15896 | |
| 15897 | (defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist |
| 15898 | &optional insert-conf) |
| 15899 | "Generate block configuration for architecture." |
| 15900 | (let ((margin (current-indentation)) |
| 15901 | (beg (point-at-bol)) |
| 15902 | ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) |
| 15903 | ;; insert block configuration (for architecture) |
| 15904 | (vhdl-insert-keyword "FOR ") (insert arch-name "\n") |
| 15905 | (setq margin (+ margin vhdl-basic-offset)) |
| 15906 | ;; process all instances |
| 15907 | (while inst-alist |
| 15908 | (setq inst-entry (car inst-alist)) |
| 15909 | ;; is component? |
| 15910 | (when (nth 4 inst-entry) |
| 15911 | (setq insert-conf t) |
| 15912 | (setq inst-path (nth 9 inst-entry)) |
| 15913 | ;; skip common path with previous instance |
| 15914 | (while (and inst-path (equal (car inst-path) (car inst-prev-path))) |
| 15915 | (setq inst-path (cdr inst-path) |
| 15916 | inst-prev-path (cdr inst-prev-path))) |
| 15917 | ;; insert block configuration end (for previous block/generate) |
| 15918 | (while inst-prev-path |
| 15919 | (setq margin (- margin vhdl-basic-offset)) |
| 15920 | (indent-to margin) |
| 15921 | (vhdl-insert-keyword "END FOR;\n") |
| 15922 | (setq inst-prev-path (cdr inst-prev-path))) |
| 15923 | ;; insert block configuration beginning (for current block/generate) |
| 15924 | (indent-to margin) |
| 15925 | (while inst-path |
| 15926 | (setq margin (+ margin vhdl-basic-offset)) |
| 15927 | (vhdl-insert-keyword "FOR ") |
| 15928 | (insert (car inst-path) "\n") |
| 15929 | (indent-to margin) |
| 15930 | (setq inst-path (cdr inst-path))) |
| 15931 | ;; insert component configuration beginning |
| 15932 | (vhdl-insert-keyword "FOR ") |
| 15933 | (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") |
| 15934 | ;; find subconfiguration |
| 15935 | (setq conf-key (nth 7 inst-entry)) |
| 15936 | (setq tmp-alist conf-alist) |
| 15937 | ;; use first configuration found for instance's entity |
| 15938 | (while (and tmp-alist (null conf-key)) |
| 15939 | (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) |
| 15940 | (setq conf-key (nth 0 (car tmp-alist)))) |
| 15941 | (setq tmp-alist (cdr tmp-alist))) |
| 15942 | (setq conf-entry (aget conf-alist conf-key t)) |
| 15943 | ;; insert binding indication ... |
| 15944 | ;; ... with subconfiguration (if exists) |
| 15945 | (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) |
| 15946 | (progn |
| 15947 | (indent-to (+ margin vhdl-basic-offset)) |
| 15948 | (vhdl-insert-keyword "USE CONFIGURATION ") |
| 15949 | (insert (vhdl-work-library) "." (nth 0 conf-entry)) |
| 15950 | (insert ";\n")) |
| 15951 | ;; ... with entity (if exists) |
| 15952 | (setq ent-entry (aget ent-alist (nth 5 inst-entry) t)) |
| 15953 | (when ent-entry |
| 15954 | (indent-to (+ margin vhdl-basic-offset)) |
| 15955 | (vhdl-insert-keyword "USE ENTITY ") |
| 15956 | (insert (vhdl-work-library) "." (nth 0 ent-entry)) |
| 15957 | ;; insert architecture name (if architecture exists) |
| 15958 | (when (nth 3 ent-entry) |
| 15959 | (setq arch-name |
| 15960 | ;; choose architecture name a) from configuration, |
| 15961 | ;; b) from mra, or c) from first architecture |
| 15962 | (or (nth 0 (aget (nth 3 ent-entry) |
| 15963 | (or (nth 6 inst-entry) |
| 15964 | (nth 4 ent-entry)) t)) |
| 15965 | (nth 1 (car (nth 3 ent-entry))))) |
| 15966 | (insert "(" arch-name ")")) |
| 15967 | (insert ";\n") |
| 15968 | ;; insert block configuration (for architecture of subcomponent) |
| 15969 | (when (and vhdl-compose-configuration-hierarchical |
| 15970 | (nth 3 ent-entry)) |
| 15971 | (indent-to (+ margin vhdl-basic-offset)) |
| 15972 | (vhdl-compose-configuration-architecture |
| 15973 | (nth 0 ent-entry) arch-name |
| 15974 | (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t)))))) |
| 15975 | ;; insert component configuration end |
| 15976 | (indent-to margin) |
| 15977 | (vhdl-insert-keyword "END FOR;\n") |
| 15978 | (setq inst-prev-path (nth 9 inst-entry))) |
| 15979 | (setq inst-alist (cdr inst-alist))) |
| 15980 | ;; insert block configuration end (for block/generate) |
| 15981 | (while inst-prev-path |
| 15982 | (setq margin (- margin vhdl-basic-offset)) |
| 15983 | (indent-to margin) |
| 15984 | (vhdl-insert-keyword "END FOR;\n") |
| 15985 | (setq inst-prev-path (cdr inst-prev-path))) |
| 15986 | (indent-to (- margin vhdl-basic-offset)) |
| 15987 | ;; insert block configuration end or remove beginning (for architecture) |
| 15988 | (if insert-conf |
| 15989 | (vhdl-insert-keyword "END FOR;\n") |
| 15990 | (delete-region beg (point))))) |
| 15991 | |
| 15992 | (defun vhdl-compose-configuration (&optional ent-name arch-name) |
| 15993 | "Generate configuration declaration." |
| 15994 | (interactive) |
| 15995 | (vhdl-require-hierarchy-info) |
| 15996 | (let ((ent-alist (aget vhdl-entity-alist |
| 15997 | (or (vhdl-project-p) default-directory) t)) |
| 15998 | (conf-alist (aget vhdl-config-alist |
| 15999 | (or (vhdl-project-p) default-directory) t)) |
| 16000 | (from-speedbar ent-name) |
| 16001 | inst-alist conf-name conf-file-name pos) |
| 16002 | (vhdl-prepare-search-2 |
| 16003 | ;; get entity and architecture name |
| 16004 | (unless ent-name |
| 16005 | (save-excursion |
| 16006 | (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) |
| 16007 | (not (equal "END" (upcase (match-string 1)))) |
| 16008 | (setq ent-name (match-string-no-properties 3)) |
| 16009 | (setq arch-name (match-string-no-properties 2))) |
| 16010 | (error "ERROR: Not within an architecture")))) |
| 16011 | (setq conf-name (vhdl-replace-string |
| 16012 | vhdl-compose-configuration-name |
| 16013 | (concat ent-name " " arch-name))) |
| 16014 | (setq inst-alist |
| 16015 | (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t)) |
| 16016 | (downcase arch-name) t)))) |
| 16017 | (message "Generating configuration \"%s\"..." conf-name) |
| 16018 | (if vhdl-compose-configuration-create-file |
| 16019 | ;; open configuration file |
| 16020 | (progn |
| 16021 | (setq conf-file-name |
| 16022 | (concat (vhdl-replace-string vhdl-configuration-file-name |
| 16023 | conf-name t) |
| 16024 | "." (file-name-extension (buffer-file-name)))) |
| 16025 | (when (and (file-exists-p conf-file-name) |
| 16026 | (not (y-or-n-p (concat "File \"" conf-file-name |
| 16027 | "\" exists; overwrite? ")))) |
| 16028 | (error "ERROR: Creating configuration...aborted")) |
| 16029 | (find-file conf-file-name) |
| 16030 | (erase-buffer) |
| 16031 | (set-buffer-modified-p nil) |
| 16032 | ;; insert header |
| 16033 | (if vhdl-compose-include-header |
| 16034 | (progn (vhdl-template-header |
| 16035 | (concat "Configuration declaration for design \"" |
| 16036 | ent-name "(" arch-name ")\"")) |
| 16037 | (goto-char (point-max))) |
| 16038 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 16039 | ;; goto end of architecture |
| 16040 | (unless from-speedbar |
| 16041 | (re-search-forward "^end\\>" nil) |
| 16042 | (end-of-line) (insert "\n\n") |
| 16043 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 16044 | ;; insert library clause |
| 16045 | (setq pos (point)) |
| 16046 | (vhdl-template-standard-package (vhdl-work-library) nil) |
| 16047 | (when (/= pos (point)) |
| 16048 | (insert "\n\n")) |
| 16049 | ;; insert configuration |
| 16050 | (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) |
| 16051 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 16052 | (vhdl-insert-keyword " IS\n") |
| 16053 | (indent-to vhdl-basic-offset) |
| 16054 | ;; insert block configuration (for architecture) |
| 16055 | (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t) |
| 16056 | (vhdl-insert-keyword "END ") (insert conf-name ";") |
| 16057 | (when conf-file-name |
| 16058 | ;; insert footer and save |
| 16059 | (insert "\n\n") |
| 16060 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 16061 | (vhdl-template-footer) |
| 16062 | (vhdl-comment-display-line) (insert "\n")) |
| 16063 | (save-buffer)) |
| 16064 | (message "%s" |
| 16065 | (concat (format "Generating configuration \"%s\"...done" conf-name) |
| 16066 | (and conf-file-name |
| 16067 | (format "\n File created: \"%s\"" conf-file-name)))))) |
| 16068 | |
| 16069 | |
| 16070 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16071 | ;;; Compilation / Makefile generation |
| 16072 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16073 | ;; (using `compile.el') |
| 16074 | |
| 16075 | (defun vhdl-makefile-name () |
| 16076 | "Return the Makefile name of the current project or the current compiler if |
| 16077 | no project is defined." |
| 16078 | (let ((project-alist (aget vhdl-project-alist vhdl-project)) |
| 16079 | (compiler-alist (aget vhdl-compiler-alist vhdl-compiler))) |
| 16080 | (vhdl-replace-string |
| 16081 | (cons "\\(.*\\)\n\\(.*\\)" |
| 16082 | (or (nth 8 project-alist) (nth 8 compiler-alist))) |
| 16083 | (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) |
| 16084 | |
| 16085 | (defun vhdl-compile-directory () |
| 16086 | "Return the directory where compilation/make should be run." |
| 16087 | (let* ((project (aget vhdl-project-alist (vhdl-project-p t))) |
| 16088 | (compiler (aget vhdl-compiler-alist vhdl-compiler)) |
| 16089 | (directory (vhdl-resolve-env-variable |
| 16090 | (if project |
| 16091 | (vhdl-replace-string |
| 16092 | (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) |
| 16093 | (nth 6 compiler))))) |
| 16094 | (file-name-as-directory |
| 16095 | (if (file-name-absolute-p directory) |
| 16096 | directory |
| 16097 | (expand-file-name directory (vhdl-default-directory)))))) |
| 16098 | |
| 16099 | (defun vhdl-uniquify (in-list) |
| 16100 | "Remove duplicate elements from IN-LIST." |
| 16101 | (let (out-list) |
| 16102 | (while in-list |
| 16103 | (add-to-list 'out-list (car in-list)) |
| 16104 | (setq in-list (cdr in-list))) |
| 16105 | out-list)) |
| 16106 | |
| 16107 | (defun vhdl-set-compiler (name) |
| 16108 | "Set current compiler to NAME." |
| 16109 | (interactive |
| 16110 | (list (let ((completion-ignore-case t)) |
| 16111 | (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) |
| 16112 | (if (assoc name vhdl-compiler-alist) |
| 16113 | (progn (setq vhdl-compiler name) |
| 16114 | (message "Current compiler: \"%s\"" vhdl-compiler)) |
| 16115 | (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) |
| 16116 | |
| 16117 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16118 | ;; Compilation |
| 16119 | |
| 16120 | (defun vhdl-compile-init () |
| 16121 | "Initialize for compilation." |
| 16122 | (when (or (null compilation-error-regexp-alist) |
| 16123 | (not (assoc (car (nth 11 (car vhdl-compiler-alist))) |
| 16124 | compilation-error-regexp-alist))) |
| 16125 | ;; `compilation-error-regexp-alist' |
| 16126 | (let ((commands-alist vhdl-compiler-alist) |
| 16127 | regexp-alist sublist) |
| 16128 | (while commands-alist |
| 16129 | (setq sublist (nth 11 (car commands-alist))) |
| 16130 | (unless (or (equal "" (car sublist)) |
| 16131 | (assoc (car sublist) regexp-alist)) |
| 16132 | (setq regexp-alist (cons (list (nth 0 sublist) |
| 16133 | (if (= 0 (nth 1 sublist)) |
| 16134 | (if (featurep 'xemacs) 9 nil) |
| 16135 | (nth 1 sublist)) |
| 16136 | (nth 2 sublist) (nth 3 sublist)) |
| 16137 | regexp-alist))) |
| 16138 | (setq commands-alist (cdr commands-alist))) |
| 16139 | (setq compilation-error-regexp-alist |
| 16140 | (append compilation-error-regexp-alist (nreverse regexp-alist)))) |
| 16141 | ;; `compilation-file-regexp-alist' |
| 16142 | (let ((commands-alist vhdl-compiler-alist) |
| 16143 | regexp-alist sublist) |
| 16144 | ;; matches vhdl-mode file name output |
| 16145 | (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) |
| 16146 | (while commands-alist |
| 16147 | (setq sublist (nth 12 (car commands-alist))) |
| 16148 | (unless (or (equal "" (car sublist)) |
| 16149 | (assoc (car sublist) regexp-alist)) |
| 16150 | (setq regexp-alist (cons sublist regexp-alist))) |
| 16151 | (setq commands-alist (cdr commands-alist))) |
| 16152 | (setq compilation-file-regexp-alist |
| 16153 | (append compilation-file-regexp-alist (nreverse regexp-alist)))))) |
| 16154 | |
| 16155 | (defvar vhdl-compile-file-name nil |
| 16156 | "Name of file to be compiled.") |
| 16157 | |
| 16158 | (defun vhdl-compile-print-file-name () |
| 16159 | "Function called within `compile' to print out file name for compilers that |
| 16160 | do not print any file names." |
| 16161 | (insert "Compiling \"" vhdl-compile-file-name "\"\n")) |
| 16162 | |
| 16163 | (defun vhdl-get-compile-options (project compiler file-name |
| 16164 | &optional file-options-only) |
| 16165 | "Get compiler options. Returning nil means do not compile this file." |
| 16166 | (let* ((compiler-options (nth 1 compiler)) |
| 16167 | (project-entry (aget (nth 4 project) vhdl-compiler)) |
| 16168 | (project-options (nth 0 project-entry)) |
| 16169 | (exception-list (and file-name (nth 2 project-entry))) |
| 16170 | (work-library (vhdl-work-library)) |
| 16171 | (case-fold-search nil) |
| 16172 | file-options) |
| 16173 | (while (and exception-list |
| 16174 | (not (string-match (caar exception-list) file-name))) |
| 16175 | (setq exception-list (cdr exception-list))) |
| 16176 | (if (and exception-list (not (cdar exception-list))) |
| 16177 | nil |
| 16178 | (if (and file-options-only (not exception-list)) |
| 16179 | 'default |
| 16180 | (setq file-options (cdar exception-list)) |
| 16181 | ;; insert library name in compiler-specific options |
| 16182 | (setq compiler-options |
| 16183 | (vhdl-replace-string (cons "\\(.*\\)" compiler-options) |
| 16184 | work-library)) |
| 16185 | ;; insert compiler-specific options in project-specific options |
| 16186 | (when project-options |
| 16187 | (setq project-options |
| 16188 | (vhdl-replace-string |
| 16189 | (cons "\\(.*\\)\n\\(.*\\)" project-options) |
| 16190 | (concat work-library "\n" compiler-options)))) |
| 16191 | ;; insert project-specific options in file-specific options |
| 16192 | (when file-options |
| 16193 | (setq file-options |
| 16194 | (vhdl-replace-string |
| 16195 | (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) |
| 16196 | (concat work-library "\n" compiler-options "\n" |
| 16197 | project-options)))) |
| 16198 | ;; return options |
| 16199 | (or file-options project-options compiler-options))))) |
| 16200 | |
| 16201 | (defun vhdl-get-make-options (project compiler) |
| 16202 | "Get make options." |
| 16203 | (let* ((compiler-options (nth 3 compiler)) |
| 16204 | (project-entry (aget (nth 4 project) vhdl-compiler)) |
| 16205 | (project-options (nth 1 project-entry)) |
| 16206 | (makefile-name (vhdl-makefile-name))) |
| 16207 | ;; insert Makefile name in compiler-specific options |
| 16208 | (setq compiler-options |
| 16209 | (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) |
| 16210 | makefile-name)) |
| 16211 | ;; insert compiler-specific options in project-specific options |
| 16212 | (when project-options |
| 16213 | (setq project-options |
| 16214 | (vhdl-replace-string |
| 16215 | (cons "\\(.*\\)\n\\(.*\\)" project-options) |
| 16216 | (concat makefile-name "\n" compiler-options)))) |
| 16217 | ;; return options |
| 16218 | (or project-options compiler-options))) |
| 16219 | |
| 16220 | (defun vhdl-compile () |
| 16221 | "Compile current buffer using the VHDL compiler specified in |
| 16222 | `vhdl-compiler'." |
| 16223 | (interactive) |
| 16224 | (vhdl-compile-init) |
| 16225 | (let* ((project (aget vhdl-project-alist vhdl-project)) |
| 16226 | (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil) |
| 16227 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 16228 | (command (nth 0 compiler)) |
| 16229 | (file-name (buffer-file-name)) |
| 16230 | (options (vhdl-get-compile-options project compiler file-name)) |
| 16231 | (default-directory (vhdl-compile-directory)) |
| 16232 | compilation-process-setup-function) |
| 16233 | (unless (file-directory-p default-directory) |
| 16234 | (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) |
| 16235 | ;; put file name into quotes if it contains spaces |
| 16236 | (when (string-match " " file-name) |
| 16237 | (setq file-name (concat "\"" file-name "\""))) |
| 16238 | ;; print out file name if compiler does not |
| 16239 | (setq vhdl-compile-file-name (buffer-file-name)) |
| 16240 | (when (and (= 0 (nth 1 (nth 10 compiler))) |
| 16241 | (= 0 (nth 1 (nth 11 compiler)))) |
| 16242 | (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) |
| 16243 | ;; run compilation |
| 16244 | (if options |
| 16245 | (when command |
| 16246 | (compile (concat command " " options " " file-name))) |
| 16247 | (vhdl-warning "Your project settings tell me not to compile this file")))) |
| 16248 | |
| 16249 | (defvar vhdl-make-target "all" |
| 16250 | "Default target for `vhdl-make' command.") |
| 16251 | |
| 16252 | (defun vhdl-make (&optional target) |
| 16253 | "Call make command for compilation of all updated source files (requires |
| 16254 | `Makefile'). Optional argument TARGET allows to compile the design |
| 16255 | specified by a target." |
| 16256 | (interactive) |
| 16257 | (setq vhdl-make-target |
| 16258 | (or target (read-from-minibuffer "Target: " vhdl-make-target |
| 16259 | vhdl-minibuffer-local-map))) |
| 16260 | (vhdl-compile-init) |
| 16261 | (let* ((project (aget vhdl-project-alist vhdl-project)) |
| 16262 | (compiler (or (aget vhdl-compiler-alist vhdl-compiler) |
| 16263 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 16264 | (command (nth 2 compiler)) |
| 16265 | (options (vhdl-get-make-options project compiler)) |
| 16266 | (default-directory (vhdl-compile-directory))) |
| 16267 | (unless (file-directory-p default-directory) |
| 16268 | (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) |
| 16269 | ;; run make |
| 16270 | (compile (concat (if (equal command "") "make" command) |
| 16271 | " " options " " vhdl-make-target)))) |
| 16272 | |
| 16273 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16274 | ;; Makefile generation |
| 16275 | |
| 16276 | (defun vhdl-generate-makefile () |
| 16277 | "Generate `Makefile'." |
| 16278 | (interactive) |
| 16279 | (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler) |
| 16280 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 16281 | (command (nth 4 compiler))) |
| 16282 | ;; generate makefile |
| 16283 | (if command |
| 16284 | (let ((default-directory (vhdl-compile-directory))) |
| 16285 | (compile (vhdl-replace-string |
| 16286 | (cons "\\(.*\\) \\(.*\\)" command) |
| 16287 | (concat (vhdl-makefile-name) " " (vhdl-work-library))))) |
| 16288 | (vhdl-generate-makefile-1)))) |
| 16289 | |
| 16290 | (defun vhdl-get-packages (lib-alist work-library) |
| 16291 | "Get packages from LIB-ALIST that belong to WORK-LIBRARY." |
| 16292 | (let (pack-list) |
| 16293 | (while lib-alist |
| 16294 | (when (equal (downcase (caar lib-alist)) (downcase work-library)) |
| 16295 | (setq pack-list (cons (cdar lib-alist) pack-list))) |
| 16296 | (setq lib-alist (cdr lib-alist))) |
| 16297 | pack-list)) |
| 16298 | |
| 16299 | (defun vhdl-generate-makefile-1 () |
| 16300 | "Generate Makefile for current project or directory." |
| 16301 | ;; scan hierarchy if required |
| 16302 | (if (vhdl-project-p) |
| 16303 | (unless (or (assoc vhdl-project vhdl-file-alist) |
| 16304 | (vhdl-load-cache vhdl-project)) |
| 16305 | (vhdl-scan-project-contents vhdl-project)) |
| 16306 | (let ((directory (abbreviate-file-name default-directory))) |
| 16307 | (unless (or (assoc directory vhdl-file-alist) |
| 16308 | (vhdl-load-cache directory)) |
| 16309 | (vhdl-scan-directory-contents directory)))) |
| 16310 | (let* ((directory (abbreviate-file-name (vhdl-default-directory))) |
| 16311 | (project (vhdl-project-p)) |
| 16312 | (ent-alist (aget vhdl-entity-alist (or project directory) t)) |
| 16313 | (conf-alist (aget vhdl-config-alist (or project directory) t)) |
| 16314 | (pack-alist (aget vhdl-package-alist (or project directory) t)) |
| 16315 | (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler))) |
| 16316 | (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list))) |
| 16317 | (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list))) |
| 16318 | (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list))) |
| 16319 | (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list))) |
| 16320 | (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list))) |
| 16321 | (adjust-case (nth 5 regexp-list)) |
| 16322 | (work-library (downcase (vhdl-work-library))) |
| 16323 | (compile-directory (expand-file-name (vhdl-compile-directory) |
| 16324 | default-directory)) |
| 16325 | (makefile-name (vhdl-makefile-name)) |
| 16326 | rule-alist arch-alist inst-alist |
| 16327 | target-list depend-list unit-list prim-list second-list subcomp-list |
| 16328 | lib-alist lib-body-alist pack-list all-pack-list |
| 16329 | ent-key ent-file-name arch-key arch-file-name ent-arch-key |
| 16330 | conf-key conf-file-name pack-key pack-file-name |
| 16331 | ent-entry arch-entry conf-entry pack-entry inst-entry |
| 16332 | pack-body-key pack-body-file-name inst-ent-key inst-conf-key |
| 16333 | tmp-key tmp-list rule) |
| 16334 | ;; check prerequisites |
| 16335 | (unless (file-exists-p compile-directory) |
| 16336 | (make-directory compile-directory t)) |
| 16337 | (unless regexp-list |
| 16338 | (error "Please contact the VHDL Mode maintainer for support of \"%s\"" |
| 16339 | vhdl-compiler)) |
| 16340 | (message "Generating makefile \"%s\"..." makefile-name) |
| 16341 | ;; rules for all entities |
| 16342 | (setq tmp-list ent-alist) |
| 16343 | (while ent-alist |
| 16344 | (setq ent-entry (car ent-alist) |
| 16345 | ent-key (nth 0 ent-entry)) |
| 16346 | (when (nth 2 ent-entry) |
| 16347 | (setq ent-file-name (file-relative-name |
| 16348 | (nth 2 ent-entry) compile-directory) |
| 16349 | arch-alist (nth 4 ent-entry) |
| 16350 | lib-alist (nth 6 ent-entry) |
| 16351 | rule (aget rule-alist ent-file-name) |
| 16352 | target-list (nth 0 rule) |
| 16353 | depend-list (nth 1 rule) |
| 16354 | second-list nil |
| 16355 | subcomp-list nil) |
| 16356 | (setq tmp-key (vhdl-replace-string |
| 16357 | ent-regexp (funcall adjust-case ent-key))) |
| 16358 | (setq unit-list (cons (cons ent-key tmp-key) unit-list)) |
| 16359 | ;; rule target for this entity |
| 16360 | (setq target-list (cons ent-key target-list)) |
| 16361 | ;; rule dependencies for all used packages |
| 16362 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 16363 | (setq depend-list (append depend-list pack-list)) |
| 16364 | (setq all-pack-list pack-list) |
| 16365 | ;; add rule |
| 16366 | (aput 'rule-alist ent-file-name (list target-list depend-list)) |
| 16367 | ;; rules for all corresponding architectures |
| 16368 | (while arch-alist |
| 16369 | (setq arch-entry (car arch-alist) |
| 16370 | arch-key (nth 0 arch-entry) |
| 16371 | ent-arch-key (concat ent-key "-" arch-key) |
| 16372 | arch-file-name (file-relative-name (nth 2 arch-entry) |
| 16373 | compile-directory) |
| 16374 | inst-alist (nth 4 arch-entry) |
| 16375 | lib-alist (nth 5 arch-entry) |
| 16376 | rule (aget rule-alist arch-file-name) |
| 16377 | target-list (nth 0 rule) |
| 16378 | depend-list (nth 1 rule)) |
| 16379 | (setq tmp-key (vhdl-replace-string |
| 16380 | arch-regexp |
| 16381 | (funcall adjust-case (concat arch-key " " ent-key)))) |
| 16382 | (setq unit-list |
| 16383 | (cons (cons ent-arch-key tmp-key) unit-list)) |
| 16384 | (setq second-list (cons ent-arch-key second-list)) |
| 16385 | ;; rule target for this architecture |
| 16386 | (setq target-list (cons ent-arch-key target-list)) |
| 16387 | ;; rule dependency for corresponding entity |
| 16388 | (setq depend-list (cons ent-key depend-list)) |
| 16389 | ;; rule dependencies for contained component instantiations |
| 16390 | (while inst-alist |
| 16391 | (setq inst-entry (car inst-alist)) |
| 16392 | (when (or (null (nth 8 inst-entry)) |
| 16393 | (equal (downcase (nth 8 inst-entry)) work-library)) |
| 16394 | (setq inst-ent-key (or (nth 7 inst-entry) |
| 16395 | (nth 5 inst-entry))) |
| 16396 | (setq depend-list (cons inst-ent-key depend-list) |
| 16397 | subcomp-list (cons inst-ent-key subcomp-list))) |
| 16398 | (setq inst-alist (cdr inst-alist))) |
| 16399 | ;; rule dependencies for all used packages |
| 16400 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 16401 | (setq depend-list (append depend-list pack-list)) |
| 16402 | (setq all-pack-list (append all-pack-list pack-list)) |
| 16403 | ;; add rule |
| 16404 | (aput 'rule-alist arch-file-name (list target-list depend-list)) |
| 16405 | (setq arch-alist (cdr arch-alist))) |
| 16406 | (setq prim-list (cons (list ent-key second-list |
| 16407 | (append subcomp-list all-pack-list)) |
| 16408 | prim-list))) |
| 16409 | (setq ent-alist (cdr ent-alist))) |
| 16410 | (setq ent-alist tmp-list) |
| 16411 | ;; rules for all configurations |
| 16412 | (setq tmp-list conf-alist) |
| 16413 | (while conf-alist |
| 16414 | (setq conf-entry (car conf-alist) |
| 16415 | conf-key (nth 0 conf-entry) |
| 16416 | conf-file-name (file-relative-name |
| 16417 | (nth 2 conf-entry) compile-directory) |
| 16418 | ent-key (nth 4 conf-entry) |
| 16419 | arch-key (nth 5 conf-entry) |
| 16420 | inst-alist (nth 6 conf-entry) |
| 16421 | lib-alist (nth 7 conf-entry) |
| 16422 | rule (aget rule-alist conf-file-name) |
| 16423 | target-list (nth 0 rule) |
| 16424 | depend-list (nth 1 rule) |
| 16425 | subcomp-list (list ent-key)) |
| 16426 | (setq tmp-key (vhdl-replace-string |
| 16427 | conf-regexp (funcall adjust-case conf-key))) |
| 16428 | (setq unit-list (cons (cons conf-key tmp-key) unit-list)) |
| 16429 | ;; rule target for this configuration |
| 16430 | (setq target-list (cons conf-key target-list)) |
| 16431 | ;; rule dependency for corresponding entity and architecture |
| 16432 | (setq depend-list |
| 16433 | (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) |
| 16434 | ;; rule dependencies for used packages |
| 16435 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 16436 | (setq depend-list (append depend-list pack-list)) |
| 16437 | ;; rule dependencies for contained component configurations |
| 16438 | (while inst-alist |
| 16439 | (setq inst-entry (car inst-alist)) |
| 16440 | (setq inst-ent-key (nth 2 inst-entry) |
| 16441 | ; comp-arch-key (nth 2 inst-entry)) |
| 16442 | inst-conf-key (nth 4 inst-entry)) |
| 16443 | (when (equal (downcase (nth 5 inst-entry)) work-library) |
| 16444 | (when inst-ent-key |
| 16445 | (setq depend-list (cons inst-ent-key depend-list) |
| 16446 | subcomp-list (cons inst-ent-key subcomp-list))) |
| 16447 | ; (when comp-arch-key |
| 16448 | ; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key) |
| 16449 | ; depend-list))) |
| 16450 | (when inst-conf-key |
| 16451 | (setq depend-list (cons inst-conf-key depend-list) |
| 16452 | subcomp-list (cons inst-conf-key subcomp-list)))) |
| 16453 | (setq inst-alist (cdr inst-alist))) |
| 16454 | ;; add rule |
| 16455 | (aput 'rule-alist conf-file-name (list target-list depend-list)) |
| 16456 | (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list)) |
| 16457 | prim-list)) |
| 16458 | (setq conf-alist (cdr conf-alist))) |
| 16459 | (setq conf-alist tmp-list) |
| 16460 | ;; rules for all packages |
| 16461 | (setq tmp-list pack-alist) |
| 16462 | (while pack-alist |
| 16463 | (setq pack-entry (car pack-alist) |
| 16464 | pack-key (nth 0 pack-entry) |
| 16465 | pack-body-key nil) |
| 16466 | (when (nth 2 pack-entry) |
| 16467 | (setq pack-file-name (file-relative-name (nth 2 pack-entry) |
| 16468 | compile-directory) |
| 16469 | lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) |
| 16470 | rule (aget rule-alist pack-file-name) |
| 16471 | target-list (nth 0 rule) depend-list (nth 1 rule)) |
| 16472 | (setq tmp-key (vhdl-replace-string |
| 16473 | pack-regexp (funcall adjust-case pack-key))) |
| 16474 | (setq unit-list (cons (cons pack-key tmp-key) unit-list)) |
| 16475 | ;; rule target for this package |
| 16476 | (setq target-list (cons pack-key target-list)) |
| 16477 | ;; rule dependencies for all used packages |
| 16478 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 16479 | (setq depend-list (append depend-list pack-list)) |
| 16480 | (setq all-pack-list pack-list) |
| 16481 | ;; add rule |
| 16482 | (aput 'rule-alist pack-file-name (list target-list depend-list)) |
| 16483 | ;; rules for this package's body |
| 16484 | (when (nth 7 pack-entry) |
| 16485 | (setq pack-body-key (concat pack-key "-body") |
| 16486 | pack-body-file-name (file-relative-name (nth 7 pack-entry) |
| 16487 | compile-directory) |
| 16488 | rule (aget rule-alist pack-body-file-name) |
| 16489 | target-list (nth 0 rule) |
| 16490 | depend-list (nth 1 rule)) |
| 16491 | (setq tmp-key (vhdl-replace-string |
| 16492 | pack-body-regexp (funcall adjust-case pack-key))) |
| 16493 | (setq unit-list |
| 16494 | (cons (cons pack-body-key tmp-key) unit-list)) |
| 16495 | ;; rule target for this package's body |
| 16496 | (setq target-list (cons pack-body-key target-list)) |
| 16497 | ;; rule dependency for corresponding package declaration |
| 16498 | (setq depend-list (cons pack-key depend-list)) |
| 16499 | ;; rule dependencies for all used packages |
| 16500 | (setq pack-list (vhdl-get-packages lib-body-alist work-library)) |
| 16501 | (setq depend-list (append depend-list pack-list)) |
| 16502 | (setq all-pack-list (append all-pack-list pack-list)) |
| 16503 | ;; add rule |
| 16504 | (aput 'rule-alist pack-body-file-name |
| 16505 | (list target-list depend-list))) |
| 16506 | (setq prim-list |
| 16507 | (cons (list pack-key (when pack-body-key (list pack-body-key)) |
| 16508 | all-pack-list) |
| 16509 | prim-list))) |
| 16510 | (setq pack-alist (cdr pack-alist))) |
| 16511 | (setq pack-alist tmp-list) |
| 16512 | ;; generate Makefile |
| 16513 | (let* ((project (aget vhdl-project-alist project)) |
| 16514 | (compiler (aget vhdl-compiler-alist vhdl-compiler)) |
| 16515 | (compiler-id (nth 9 compiler)) |
| 16516 | (library-directory |
| 16517 | (vhdl-resolve-env-variable |
| 16518 | (vhdl-replace-string |
| 16519 | (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) |
| 16520 | compiler-id))) |
| 16521 | (makefile-path-name (expand-file-name |
| 16522 | makefile-name compile-directory)) |
| 16523 | (orig-buffer (current-buffer)) |
| 16524 | cell second-list subcomp-list options unit-key unit-name) |
| 16525 | ;; sort lists |
| 16526 | (setq unit-list (vhdl-sort-alist unit-list)) |
| 16527 | (setq prim-list (vhdl-sort-alist prim-list)) |
| 16528 | (setq tmp-list rule-alist) |
| 16529 | (while tmp-list ; pre-sort rule targets |
| 16530 | (setq cell (cdar tmp-list)) |
| 16531 | (setcar cell (sort (car cell) 'string<)) |
| 16532 | (setq tmp-list (cdr tmp-list))) |
| 16533 | (setq rule-alist ; sort by first rule target |
| 16534 | (sort rule-alist |
| 16535 | (function (lambda (a b) |
| 16536 | (string< (car (cadr a)) (car (cadr b))))))) |
| 16537 | ;; open and clear Makefile |
| 16538 | (set-buffer (find-file-noselect makefile-path-name t t)) |
| 16539 | (erase-buffer) |
| 16540 | (insert "# -*- Makefile -*-\n" |
| 16541 | "### " (file-name-nondirectory makefile-name) |
| 16542 | " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version |
| 16543 | "\n") |
| 16544 | (if project |
| 16545 | (insert "\n# Project : " (nth 0 project)) |
| 16546 | (insert "\n# Directory : \"" directory "\"")) |
| 16547 | (insert "\n# Platform : " vhdl-compiler |
| 16548 | "\n# Generated : " (format-time-string "%Y-%m-%d %T ") |
| 16549 | (user-login-name) "\n") |
| 16550 | ;; insert compile and option variable settings |
| 16551 | (insert "\n\n# Define compilation command and options\n" |
| 16552 | "\nCOMPILE = " (nth 0 compiler) |
| 16553 | "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) |
| 16554 | "\n") |
| 16555 | ;; insert library paths |
| 16556 | (setq library-directory |
| 16557 | (directory-file-name |
| 16558 | (if (file-name-absolute-p library-directory) |
| 16559 | library-directory |
| 16560 | (file-relative-name |
| 16561 | (expand-file-name library-directory directory) |
| 16562 | compile-directory)))) |
| 16563 | (insert "\n\n# Define library paths\n" |
| 16564 | "\nLIBRARY-" work-library " = " library-directory "\n") |
| 16565 | ;; insert variable definitions for all library unit files |
| 16566 | (insert "\n\n# Define library unit files\n") |
| 16567 | (setq tmp-list unit-list) |
| 16568 | (while unit-list |
| 16569 | (insert "\nUNIT-" work-library "-" (caar unit-list) |
| 16570 | " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list)) |
| 16571 | (setq unit-list (cdr unit-list))) |
| 16572 | ;; insert variable definition for list of all library unit files |
| 16573 | (insert "\n\n\n# Define list of all library unit files\n" |
| 16574 | "\nALL_UNITS =") |
| 16575 | (setq unit-list tmp-list) |
| 16576 | (while unit-list |
| 16577 | (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") |
| 16578 | (setq unit-list (cdr unit-list))) |
| 16579 | (insert "\n") |
| 16580 | (setq unit-list tmp-list) |
| 16581 | ;; insert `make all' rule |
| 16582 | (insert "\n\n\n# Rule for compiling entire design\n" |
| 16583 | "\nall :" |
| 16584 | " \\\n\t\tlibrary" |
| 16585 | " \\\n\t\t$(ALL_UNITS)\n") |
| 16586 | ;; insert `make clean' rule |
| 16587 | (insert "\n\n# Rule for cleaning entire design\n" |
| 16588 | "\nclean : " |
| 16589 | "\n\t-rm -f $(ALL_UNITS)\n") |
| 16590 | ;; insert `make library' rule |
| 16591 | (insert "\n\n# Rule for creating library directory\n" |
| 16592 | "\nlibrary :" |
| 16593 | " \\\n\t\t$(LIBRARY-" work-library ")\n" |
| 16594 | "\n$(LIBRARY-" work-library ") :" |
| 16595 | "\n\t" |
| 16596 | (vhdl-replace-string |
| 16597 | (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) |
| 16598 | (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) |
| 16599 | "\n") |
| 16600 | ;; insert rule for each library unit |
| 16601 | (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") |
| 16602 | (while prim-list |
| 16603 | (setq second-list (sort (nth 1 (car prim-list)) 'string<)) |
| 16604 | (setq subcomp-list |
| 16605 | (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) |
| 16606 | (setq unit-key (caar prim-list) |
| 16607 | unit-name (or (nth 0 (aget ent-alist unit-key t)) |
| 16608 | (nth 0 (aget conf-alist unit-key t)) |
| 16609 | (nth 0 (aget pack-alist unit-key t)))) |
| 16610 | (insert "\n" unit-key) |
| 16611 | (unless (equal unit-key unit-name) |
| 16612 | (insert " \\\n" unit-name)) |
| 16613 | (insert " :" |
| 16614 | " \\\n\t\tlibrary" |
| 16615 | " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") |
| 16616 | (while second-list |
| 16617 | (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") |
| 16618 | (setq second-list (cdr second-list))) |
| 16619 | (while subcomp-list |
| 16620 | (when (and (assoc (car subcomp-list) unit-list) |
| 16621 | (not (equal unit-key (car subcomp-list)))) |
| 16622 | (insert " \\\n\t\t" (car subcomp-list))) |
| 16623 | (setq subcomp-list (cdr subcomp-list))) |
| 16624 | (insert "\n") |
| 16625 | (setq prim-list (cdr prim-list))) |
| 16626 | ;; insert rule for each library unit file |
| 16627 | (insert "\n\n# Rules for compiling single library unit files\n") |
| 16628 | (while rule-alist |
| 16629 | (setq rule (car rule-alist)) |
| 16630 | ;; get compiler options for this file |
| 16631 | (setq options |
| 16632 | (vhdl-get-compile-options project compiler (nth 0 rule) t)) |
| 16633 | ;; insert rule if file is supposed to be compiled |
| 16634 | (setq target-list (nth 1 rule) |
| 16635 | depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) |
| 16636 | ;; insert targets |
| 16637 | (setq tmp-list target-list) |
| 16638 | (while target-list |
| 16639 | (insert "\n$(UNIT-" work-library "-" (car target-list) ")" |
| 16640 | (if (cdr target-list) " \\" " :")) |
| 16641 | (setq target-list (cdr target-list))) |
| 16642 | (setq target-list tmp-list) |
| 16643 | ;; insert file name as first dependency |
| 16644 | (insert " \\\n\t\t" (nth 0 rule)) |
| 16645 | ;; insert dependencies (except if also target or unit does not exist) |
| 16646 | (while depend-list |
| 16647 | (when (and (not (member (car depend-list) target-list)) |
| 16648 | (assoc (car depend-list) unit-list)) |
| 16649 | (insert " \\\n\t\t" |
| 16650 | "$(UNIT-" work-library "-" (car depend-list) ")")) |
| 16651 | (setq depend-list (cdr depend-list))) |
| 16652 | ;; insert compile command |
| 16653 | (if options |
| 16654 | (insert "\n\t$(COMPILE) " |
| 16655 | (if (eq options 'default) "$(OPTIONS)" options) " " |
| 16656 | (nth 0 rule) "\n") |
| 16657 | (setq tmp-list target-list) |
| 16658 | (while target-list |
| 16659 | (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")" |
| 16660 | (if (cdr target-list) " \\" "\n")) |
| 16661 | (setq target-list (cdr target-list))) |
| 16662 | (setq target-list tmp-list)) |
| 16663 | (setq rule-alist (cdr rule-alist))) |
| 16664 | (insert "\n\n### " makefile-name " ends here\n") |
| 16665 | ;; run Makefile generation hook |
| 16666 | (run-hooks 'vhdl-makefile-generation-hook) |
| 16667 | (message "Generating makefile \"%s\"...done" makefile-name) |
| 16668 | ;; save and close file |
| 16669 | (if (file-writable-p makefile-path-name) |
| 16670 | (progn (save-buffer) |
| 16671 | (kill-buffer (current-buffer)) |
| 16672 | (set-buffer orig-buffer) |
| 16673 | (add-to-history 'file-name-history makefile-path-name)) |
| 16674 | (vhdl-warning-when-idle |
| 16675 | (format "File not writable: \"%s\"" |
| 16676 | (abbreviate-file-name makefile-path-name))) |
| 16677 | (switch-to-buffer (current-buffer)))))) |
| 16678 | |
| 16679 | |
| 16680 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16681 | ;;; Bug reports |
| 16682 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16683 | ;; (using `reporter.el') |
| 16684 | |
| 16685 | (defconst vhdl-mode-help-address |
| 16686 | "Reto Zimmermann <reto@gnu.org>" |
| 16687 | "Address for VHDL Mode bug reports.") |
| 16688 | |
| 16689 | (defun vhdl-submit-bug-report () |
| 16690 | "Submit via mail a bug report on VHDL Mode." |
| 16691 | (interactive) |
| 16692 | ;; load in reporter |
| 16693 | (and |
| 16694 | (y-or-n-p "Do you want to submit a report on VHDL Mode? ") |
| 16695 | (let ((reporter-prompt-for-summary-p t)) |
| 16696 | (reporter-submit-bug-report |
| 16697 | vhdl-mode-help-address |
| 16698 | (concat "VHDL Mode " vhdl-version) |
| 16699 | (list |
| 16700 | ;; report all important user options |
| 16701 | 'vhdl-offsets-alist |
| 16702 | 'vhdl-comment-only-line-offset |
| 16703 | 'tab-width |
| 16704 | 'vhdl-electric-mode |
| 16705 | 'vhdl-stutter-mode |
| 16706 | 'vhdl-indent-tabs-mode |
| 16707 | 'vhdl-project-alist |
| 16708 | 'vhdl-project |
| 16709 | 'vhdl-project-file-name |
| 16710 | 'vhdl-project-auto-load |
| 16711 | 'vhdl-project-sort |
| 16712 | 'vhdl-compiler-alist |
| 16713 | 'vhdl-compiler |
| 16714 | 'vhdl-compile-use-local-error-regexp |
| 16715 | 'vhdl-makefile-generation-hook |
| 16716 | 'vhdl-default-library |
| 16717 | 'vhdl-standard |
| 16718 | 'vhdl-basic-offset |
| 16719 | 'vhdl-upper-case-keywords |
| 16720 | 'vhdl-upper-case-types |
| 16721 | 'vhdl-upper-case-attributes |
| 16722 | 'vhdl-upper-case-enum-values |
| 16723 | 'vhdl-upper-case-constants |
| 16724 | 'vhdl-use-direct-instantiation |
| 16725 | 'vhdl-compose-configuration-name |
| 16726 | 'vhdl-entity-file-name |
| 16727 | 'vhdl-architecture-file-name |
| 16728 | 'vhdl-configuration-file-name |
| 16729 | 'vhdl-package-file-name |
| 16730 | 'vhdl-file-name-case |
| 16731 | 'vhdl-electric-keywords |
| 16732 | 'vhdl-optional-labels |
| 16733 | 'vhdl-insert-empty-lines |
| 16734 | 'vhdl-argument-list-indent |
| 16735 | 'vhdl-association-list-with-formals |
| 16736 | 'vhdl-conditions-in-parenthesis |
| 16737 | 'vhdl-zero-string |
| 16738 | 'vhdl-one-string |
| 16739 | 'vhdl-file-header |
| 16740 | 'vhdl-file-footer |
| 16741 | 'vhdl-company-name |
| 16742 | 'vhdl-copyright-string |
| 16743 | 'vhdl-platform-spec |
| 16744 | 'vhdl-date-format |
| 16745 | 'vhdl-modify-date-prefix-string |
| 16746 | 'vhdl-modify-date-on-saving |
| 16747 | 'vhdl-reset-kind |
| 16748 | 'vhdl-reset-active-high |
| 16749 | 'vhdl-clock-rising-edge |
| 16750 | 'vhdl-clock-edge-condition |
| 16751 | 'vhdl-clock-name |
| 16752 | 'vhdl-reset-name |
| 16753 | 'vhdl-model-alist |
| 16754 | 'vhdl-include-port-comments |
| 16755 | 'vhdl-include-direction-comments |
| 16756 | 'vhdl-include-type-comments |
| 16757 | 'vhdl-include-group-comments |
| 16758 | 'vhdl-actual-port-name |
| 16759 | 'vhdl-instance-name |
| 16760 | 'vhdl-testbench-entity-name |
| 16761 | 'vhdl-testbench-architecture-name |
| 16762 | 'vhdl-testbench-configuration-name |
| 16763 | 'vhdl-testbench-dut-name |
| 16764 | 'vhdl-testbench-include-header |
| 16765 | 'vhdl-testbench-declarations |
| 16766 | 'vhdl-testbench-statements |
| 16767 | 'vhdl-testbench-initialize-signals |
| 16768 | 'vhdl-testbench-include-library |
| 16769 | 'vhdl-testbench-include-configuration |
| 16770 | 'vhdl-testbench-create-files |
| 16771 | 'vhdl-testbench-entity-file-name |
| 16772 | 'vhdl-testbench-architecture-file-name |
| 16773 | 'vhdl-compose-create-files |
| 16774 | 'vhdl-compose-configuration-create-file |
| 16775 | 'vhdl-compose-configuration-hierarchical |
| 16776 | 'vhdl-compose-configuration-use-subconfiguration |
| 16777 | 'vhdl-compose-include-header |
| 16778 | 'vhdl-compose-architecture-name |
| 16779 | 'vhdl-components-package-name |
| 16780 | 'vhdl-use-components-package |
| 16781 | 'vhdl-self-insert-comments |
| 16782 | 'vhdl-prompt-for-comments |
| 16783 | 'vhdl-inline-comment-column |
| 16784 | 'vhdl-end-comment-column |
| 16785 | 'vhdl-auto-align |
| 16786 | 'vhdl-align-groups |
| 16787 | 'vhdl-align-group-separate |
| 16788 | 'vhdl-align-same-indent |
| 16789 | 'vhdl-highlight-keywords |
| 16790 | 'vhdl-highlight-names |
| 16791 | 'vhdl-highlight-special-words |
| 16792 | 'vhdl-highlight-forbidden-words |
| 16793 | 'vhdl-highlight-verilog-keywords |
| 16794 | 'vhdl-highlight-translate-off |
| 16795 | 'vhdl-highlight-case-sensitive |
| 16796 | 'vhdl-special-syntax-alist |
| 16797 | 'vhdl-forbidden-words |
| 16798 | 'vhdl-forbidden-syntax |
| 16799 | 'vhdl-directive-keywords |
| 16800 | 'vhdl-speedbar-auto-open |
| 16801 | 'vhdl-speedbar-display-mode |
| 16802 | 'vhdl-speedbar-scan-limit |
| 16803 | 'vhdl-speedbar-jump-to-unit |
| 16804 | 'vhdl-speedbar-update-on-saving |
| 16805 | 'vhdl-speedbar-save-cache |
| 16806 | 'vhdl-speedbar-cache-file-name |
| 16807 | 'vhdl-index-menu |
| 16808 | 'vhdl-source-file-menu |
| 16809 | 'vhdl-hideshow-menu |
| 16810 | 'vhdl-hide-all-init |
| 16811 | 'vhdl-print-two-column |
| 16812 | 'vhdl-print-customize-faces |
| 16813 | 'vhdl-intelligent-tab |
| 16814 | 'vhdl-indent-syntax-based |
| 16815 | 'vhdl-word-completion-case-sensitive |
| 16816 | 'vhdl-word-completion-in-minibuffer |
| 16817 | 'vhdl-underscore-is-part-of-word |
| 16818 | 'vhdl-mode-hook) |
| 16819 | (function |
| 16820 | (lambda () |
| 16821 | (insert |
| 16822 | (if vhdl-special-indent-hook |
| 16823 | (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" |
| 16824 | "vhdl-special-indent-hook is set to '" |
| 16825 | (format "%s" vhdl-special-indent-hook) |
| 16826 | ".\nPerhaps this is your problem?\n" |
| 16827 | "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") |
| 16828 | "\n")))) |
| 16829 | nil |
| 16830 | "Hi Reto,")))) |
| 16831 | |
| 16832 | |
| 16833 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16834 | ;;; Documentation |
| 16835 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16836 | |
| 16837 | (defconst vhdl-doc-release-notes nil |
| 16838 | "\ |
| 16839 | Release Notes for VHDL Mode 3.33 |
| 16840 | ================================ |
| 16841 | |
| 16842 | - New Features |
| 16843 | - User Options |
| 16844 | |
| 16845 | |
| 16846 | New Features |
| 16847 | ------------ |
| 16848 | |
| 16849 | CONFIGURATION DECLARATION GENERATION: |
| 16850 | - Automatic generation of a configuration declaration for a design. |
| 16851 | (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) |
| 16852 | |
| 16853 | |
| 16854 | User Options |
| 16855 | ------------ |
| 16856 | |
| 16857 | `vhdl-configuration-file-name': (new) |
| 16858 | Specify how the configuration file name is obtained. |
| 16859 | `vhdl-compose-configuration-name': (new) |
| 16860 | Specify how the configuration name is obtained. |
| 16861 | `vhdl-compose-configuration-create-file': (new) |
| 16862 | Specify whether a new file should be created for a configuration. |
| 16863 | `vhdl-compose-configuration-hierarchical': (new) |
| 16864 | Specify whether hierarchical configurations should be created. |
| 16865 | `vhdl-compose-configuration-use-subconfiguration': (new) |
| 16866 | Specify whether subconfigurations should be used inside configurations. |
| 16867 | ") |
| 16868 | |
| 16869 | |
| 16870 | (defconst vhdl-doc-keywords nil |
| 16871 | "\ |
| 16872 | Reserved words in VHDL |
| 16873 | ---------------------- |
| 16874 | |
| 16875 | VHDL'93 (IEEE Std 1076-1993): |
| 16876 | `vhdl-93-keywords' : keywords |
| 16877 | `vhdl-93-types' : standardized types |
| 16878 | `vhdl-93-attributes' : standardized attributes |
| 16879 | `vhdl-93-enum-values' : standardized enumeration values |
| 16880 | `vhdl-93-functions' : standardized functions |
| 16881 | `vhdl-93-packages' : standardized packages and libraries |
| 16882 | |
| 16883 | VHDL-AMS (IEEE Std 1076.1): |
| 16884 | `vhdl-ams-keywords' : keywords |
| 16885 | `vhdl-ams-types' : standardized types |
| 16886 | `vhdl-ams-attributes' : standardized attributes |
| 16887 | `vhdl-ams-enum-values' : standardized enumeration values |
| 16888 | `vhdl-ams-functions' : standardized functions |
| 16889 | |
| 16890 | Math Packages (IEEE Std 1076.2): |
| 16891 | `vhdl-math-types' : standardized types |
| 16892 | `vhdl-math-constants' : standardized constants |
| 16893 | `vhdl-math-functions' : standardized functions |
| 16894 | `vhdl-math-packages' : standardized packages |
| 16895 | |
| 16896 | Forbidden words: |
| 16897 | `vhdl-verilog-keywords' : Verilog reserved words |
| 16898 | |
| 16899 | NOTE: click `mouse-2' on variable names above (not in XEmacs).") |
| 16900 | |
| 16901 | |
| 16902 | (defconst vhdl-doc-coding-style nil |
| 16903 | "\ |
| 16904 | For VHDL coding style and naming convention guidelines, see the following |
| 16905 | references: |
| 16906 | |
| 16907 | \[1] Ben Cohen. |
| 16908 | \"VHDL Coding Styles and Methodologies\". |
| 16909 | Kluwer Academic Publishers, 1999. |
| 16910 | http://members.aol.com/vhdlcohen/vhdl/ |
| 16911 | |
| 16912 | \[2] Michael Keating and Pierre Bricaud. |
| 16913 | \"Reuse Methodology Manual, Second Edition\". |
| 16914 | Kluwer Academic Publishers, 1999. |
| 16915 | http://www.openmore.com/openmore/rmm2.html |
| 16916 | |
| 16917 | \[3] European Space Agency. |
| 16918 | \"VHDL Modelling Guidelines\". |
| 16919 | ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps} |
| 16920 | |
| 16921 | Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' |
| 16922 | to visually support naming conventions.") |
| 16923 | |
| 16924 | |
| 16925 | (defun vhdl-version () |
| 16926 | "Echo the current version of VHDL Mode in the minibuffer." |
| 16927 | (interactive) |
| 16928 | (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) |
| 16929 | (vhdl-keep-region-active)) |
| 16930 | |
| 16931 | (defun vhdl-doc-variable (variable) |
| 16932 | "Display VARIABLE's documentation in *Help* buffer." |
| 16933 | (interactive) |
| 16934 | (unless (featurep 'xemacs) |
| 16935 | (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p))) |
| 16936 | (with-output-to-temp-buffer |
| 16937 | (if (fboundp 'help-buffer) (help-buffer) "*Help*") |
| 16938 | (princ (documentation-property variable 'variable-documentation)) |
| 16939 | (with-current-buffer standard-output |
| 16940 | (help-mode)) |
| 16941 | (help-print-return-message))) |
| 16942 | |
| 16943 | (defun vhdl-doc-mode () |
| 16944 | "Display VHDL Mode documentation in *Help* buffer." |
| 16945 | (interactive) |
| 16946 | (unless (featurep 'xemacs) |
| 16947 | (help-setup-xref (list #'vhdl-doc-mode) (interactive-p))) |
| 16948 | (with-output-to-temp-buffer |
| 16949 | (if (fboundp 'help-buffer) (help-buffer) "*Help*") |
| 16950 | (princ mode-name) |
| 16951 | (princ " mode:\n") |
| 16952 | (princ (documentation 'vhdl-mode)) |
| 16953 | (with-current-buffer standard-output |
| 16954 | (help-mode)) |
| 16955 | (help-print-return-message))) |
| 16956 | |
| 16957 | |
| 16958 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16959 | |
| 16960 | (provide 'vhdl-mode) |
| 16961 | |
| 16962 | ;;; vhdl-mode.el ends here |