;;; vhdl-mode.el --- major mode for editing VHDL code
-;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2016 Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
-(defconst vhdl-version "3.34.2"
+(defconst vhdl-version "3.38.1"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2012-11-21"
+(defconst vhdl-time-stamp "2015-03-12"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
;; - Block commenting
;; - Code fixing/alignment/beautification
;; - PostScript printing
-;; - VHDL'87/'93 and VHDL-AMS supported
+;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported
;; - Comprehensive menu
;; - Fully customizable
;; - Works under GNU Emacs (recommended) and XEmacs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; this updated version was only tested on: GNU Emacs 20.4
+;; this updated version was only tested on: GNU Emacs 24.1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
'/' or is empty)."
(let ((val (widget-value widget)))
(unless (string-match "^\\(\\|.*/\\)$" val)
- (widget-put widget :error "Invalid directory entry: must end with '/'")
+ (widget-put widget :error "Invalid directory entry: must end with `/'")
widget)))
;; help string for user options
;; [Error] Assignment error: variable is illegal target of signal assignment
("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
- ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1)
+ ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1)
("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
"PACK/\\1.vif" "BODY/\\1.vif" upcase))
;; Aldec
;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3
("Aldec" "vcom" "-work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
- (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
+ ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
nil)
;; Cadence Leapfrog: cv -file test.vhd
;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
- ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1/entity" "\\2/\\1" "\\1/configuration"
"\\1/package" "\\1/body" downcase))
;; Cadence Affirma NC vhdl: ncvhdl test.vhd
;; (PLL_400X_TOP) is not declared [10.3].
("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
- ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
"\\1/package/pc.db" "\\1/body/pc.db" downcase))
- ;; ghdl vhdl: ghdl test.vhd
+ ;; ghdl vhdl
+ ;; ghdl -a bad_counter.vhdl
+ ;; bad_counter.vhdl:13:14: operator "=" is overloaded
("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
- ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity" "\\2/\\1" "\\1/configuration"
"\\1/package" "\\1/body" downcase))
;; IBM Compiler
;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6
("IBM Compiler" "g2tvc" "-src" "precomp" "\\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ibm"
- ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
+ ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
nil)
;; Ikos Voyager: analyze test.vhd
;; analyze test.vhd
;; E L4/C5: this library unit is inaccessible
("Ikos" "analyze" "-l \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
- ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
+ ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
nil)
;; ModelSim, Model Technology: vcom test.vhd
;; WARNING[2]: test.vhd(85): Possible infinite loop
;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
+ ;; ** Error: counter_rtl.vhd(18): Nonresolved signal 'hallo' has multiple sources.
+ ;; Drivers:
+ ;; counter_rtl.vhd(27):Conditional signal assignment line__27
+ ;; counter_rtl.vhd(29):Conditional signal assignment line__29
("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
- ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0)
+ ("\\(ERROR:\\|WARNING\\[[0-9]+\\]:\\|\\*\\* Error:\\|\\*\\* Warning: \\[[0-9]+\\]\\| +\\) \\([^ ]+\\)(\\([0-9]+\\)):" 2 3 nil)
+ ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
;; test.vhd:34: error message
("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
- ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
+ ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
"PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
;; Quartus compiler
;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ...
("Quartus" "make" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "quartus"
- ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
+ ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
nil)
;; QuickHDL, Mentor Graphics: qvhcom test.vhd
;; ERROR: test.vhd(24): near "dnd": expecting: END
;; WARNING[4]: test.vhd(30): A space is required between ...
("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
- ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
+ ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; Savant: scram -publish-cc test.vhd
;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
- ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
+ ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
"\\1_config.vhdl" "\\1_package.vhdl"
"\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "simili"
- ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
+ ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
"\\1/prim.var" "\\1/_body.var" downcase))
;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
- ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
+ ("^ *ERROR\\[[0-9]+]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
nil)
;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
- ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
- ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
;; Synplify:
;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
("Synplify" "n/a" "n/a" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
- ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
+ ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
nil)
;; Vantage: analyze -libfile vsslib.ini -src test.vhd
;; Compiling "test.vhd" line 1...
;; **Error: LINE 49 *** No aggregate value is valid in this context.
("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
- ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
+ ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
;; VeriBest: vc vhdl test.vhd
;; **Error: LINE 49 *** No aggregate value is valid in this context.
("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
- ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
+ ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
;; Xilinx XST:
;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
("Xilinx XST" "xflow" "" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
- ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0)
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil) ("" 0)
nil)
)
"List of available VHDL compilers and their properties.
Make command : command used for compilation using a Makefile
Make options : make options (\"\\1\" inserts Makefile name)
Generate Makefile: use built-in function or command to generate a Makefile
- \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
- Library command : command to create library directory \(\"\\1\" inserts
+ (\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
+ Library command : command to create library directory (\"\\1\" inserts
library directory, \"\\2\" inserts library name)
Compile directory: where compilation is run and the Makefile is placed
Library directory: directory of default library
Unit-to-file name mapping: mapping of library unit names to names of files
generated by the compiler (used for Makefile generation)
To string : string a name is mapped to (\"\\1\" inserts the unit name,
- \"\\2\" inserts the entity name for architectures)
+ \"\\2\" inserts the entity name for architectures,
+ \"\\3\" inserts the library name)
Case adjustment : adjust case of inserted unit names
\(*) The regular expression must match the error message starting from the
(append '(choice) (nreverse list)))
:group 'vhdl-compile)
-(defcustom vhdl-compile-use-local-error-regexp t
+(defcustom vhdl-compile-use-local-error-regexp nil
"Non-nil means use buffer-local `compilation-error-regexp-alist'.
In this case, only error message regexps for VHDL compilers are active if
compilation is started from a VHDL buffer. Otherwise, the error message
might result in erroneous parsing of error messages for some VHDL compilers.
NOTE: Activate the new setting by restarting Emacs."
+ :version "25.1" ; t -> nil
:type 'boolean
:group 'vhdl-compile)
Allows you to insert user specific parts into a Makefile.
Example:
- \(lambda nil
- \(re-search-backward \"^# Rule for compiling entire design\")
- \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
+ (lambda nil
+ (re-search-backward \"^# Rule for compiling entire design\")
+ (insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
:type 'hook
:group 'vhdl-compile)
\"\\3\" project-specific options)
- Do not compile: do not compile this file (in Makefile)
Compile directory: where compilation is run and the Makefile is placed
- \(\"\\1\" inserts compiler ID string)
+ (\"\\1\" inserts compiler ID string)
Library name : name of library (default is \"work\")
Library directory: path to library (\"\\1\" inserts compiler ID string)
Makefile name : name of Makefile
The default directory must have an absolute path (use `M-TAB' for completion).
All other paths can be absolute or relative to the default directory. All
-paths must end with '/'.
+paths must end with `/'.
The design units found in the sources (files and directories) are shown in the
hierarchy browser. Path and file name can contain wildcards `*' and `?' as
Basic standard:
VHDL'87 : IEEE Std 1076-1987
VHDL'93/02 : IEEE Std 1076-1993/2002
+ VHDL'08 : IEEE Std 1076-2008
Additional standards:
VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
\"Activate Options\"."
:type '(list (choice :tag "Basic standard"
(const :tag "VHDL'87" 87)
- (const :tag "VHDL'93/02" 93))
+ (const :tag "VHDL'93/02" 93)
+ (const :tag "VHDL'08" 08))
(set :tag "Additional standards" :indent 2
(const :tag "VHDL-AMS" ams)
(const :tag "Math packages" math)))
:type 'boolean
:group 'vhdl-template)
+(defcustom vhdl-sensitivity-list-all t
+ "Non-nil means use `all' keyword in sensitivity list."
+ :version "25.1"
+ :type 'boolean
+ :group 'vhdl-template)
+
(defcustom vhdl-zero-string "'0'"
"String to use for a logic zero."
:type 'string
The following keywords for template generation are supported:
<filename> : replaced by the name of the buffer
<author> : replaced by the user name and email address
- \(`user-full-name',`mail-host-address', `user-mail-address')
+ (`user-full-name',`mail-host-address', `user-mail-address')
<authorfull> : replaced by the user full name (`user-full-name')
<login> : replaced by user login name (`user-login-name')
<company> : replaced by contents of option `vhdl-company-name'
"Customizations for sequential processes."
:group 'vhdl-template)
-(defcustom vhdl-reset-kind 'async
+(defcustom vhdl-reset-kind 'async
"Specifies which kind of reset to use in sequential processes."
:type '(choice (const :tag "None" none)
(const :tag "Synchronous" sync)
(defcustom vhdl-clock-edge-condition 'standard
"Syntax of the clock edge condition.
- Standard: \"clk'event and clk = '1'\"
+ Standard: \"clk\\='event and clk = \\='1\\='\"
Function: \"rising_edge(clk)\""
:type '(choice (const :tag "Standard" standard)
(const :tag "Function" function))
Name : string of words and spaces
Regexp : regular expression describing word syntax
- (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
- expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
+ (e.g., `\\=\\<\\w+_c\\>' matches word with suffix `_c')
+ expression must start with `\\=\\<' and end with `\\>'
if only whole words should be matched (no substrings)
Color (light): foreground color for light background
(matching color examples: Gold3, Grey50, LimeGreen, Tomato,
In comments : If non-nil, words are also highlighted inside comments
Can be used for visual support of naming conventions, such as highlighting
-different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
-\"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
+different kinds of signals (e.g. `Clk50', `Rst_n') or objects (e.g.
+`Signal_s', `Variable_v', `Constant_c') by distinguishing them using
common substrings or name suffices.
For each entry, a new face is generated with the specified colors and name
-\"vhdl-font-lock-\" + name + \"-face\".
+`vhdl-font-lock-' + name + `-face'.
NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
- entry \"Fontify Buffer\"). All other changes require restarting Emacs."
+ entry `Fontify Buffer'). All other changes require restarting Emacs."
:type '(repeat (list :tag "Face" :indent 2
(string :tag "Name ")
(regexp :tag "Regexp " "\\w+_")
'vhdl-words-init 'vhdl-font-lock-init))
:group 'vhdl-highlight)
-(defcustom vhdl-directive-keywords '("pragma" "synopsys")
+(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
"List of compiler directive keywords recognized for highlighting.
NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
(package . 0)
(architecture . 0)
(package-body . 0)
+ (context . 0)
+ (directive . 0)
)
"Default settings for offsets of syntactic elements.
Do not change this constant! See the variable `vhdl-offsets-alist' for
configuration -- inside a configuration declaration
package -- inside a package declaration
architecture -- inside an architecture body
- package-body -- inside a package body")
+ package-body -- inside a package body
+ context -- inside a context declaration")
(defvar vhdl-comment-only-line-offset 0
"Extra offset for line which contains only the start of a comment.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mandatory
-(require 'assoc)
(require 'compile) ; XEmacs
(require 'easymenu)
(require 'hippie-exp)
(require 'ps-print)
(require 'speedbar))) ; for speedbar-with-writable
+(defun vhdl-aput (alist-symbol key &optional value)
+ "Insert a key-value pair into an alist.
+The alist is referenced by ALIST-SYMBOL. The key-value pair is made
+from KEY and VALUE. If the key-value pair referenced by KEY can be
+found in the alist, the value of KEY will be set to VALUE. If the
+key-value pair cannot be found in the alist, it will be inserted into
+the head of the alist."
+ (let* ((alist (symbol-value alist-symbol))
+ (elem (assoc key alist)))
+ (if elem
+ (setcdr elem value)
+ (set alist-symbol (cons (cons key value) alist)))))
+
+(defun vhdl-adelete (alist-symbol key)
+ "Delete a key-value pair from the alist.
+Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
+is pair matching KEY."
+ (let ((alist (symbol-value alist-symbol)) alist-cdr)
+ (while (equal key (caar alist))
+ (setq alist (cdr alist))
+ (set alist-symbol alist))
+ (while (setq alist-cdr (cdr alist))
+ (if (equal key (caar alist-cdr))
+ (setcdr alist (cdr alist-cdr))
+ (setq alist alist-cdr)))))
+
+(defun vhdl-aget (alist key)
+ "Return the value in ALIST that is associated with KEY. If KEY is
+not found, then nil is returned."
+ (cdr (assoc key alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility
"Wait until idle, then run FUNCTION."
(if (fboundp 'start-itimer)
(start-itimer "vhdl-mode" function secs repeat t)
-; (run-with-idle-timer secs repeat function)))
;; explicitly activate timer (necessary when Emacs is already idle)
(aset (run-with-idle-timer secs repeat function) 0 nil)))
(defun vhdl-warning-when-idle (&rest args)
"Wait until idle, then print out warning STRING and beep."
- (if noninteractive
- (vhdl-warning (apply 'format args) t)
- (unless vhdl-warnings
- (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
- (push (apply 'format args) vhdl-warnings)))
+ (let ((message (apply #'format-message args)))
+ (if noninteractive
+ (vhdl-warning message t)
+ (unless vhdl-warnings
+ (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
+ (push message vhdl-warnings))))
(defun vhdl-warning (string &optional nobeep)
"Print out warning STRING and beep."
current buffer if no project is defined."
(if (vhdl-project-p)
(expand-file-name (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist vhdl-project))))
+ (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
default-directory))
(defmacro vhdl-prepare-search-1 (&rest body)
- "Enable case insensitive search and switch to syntax table that includes '_',
+ "Enable case insensitive search and switch to syntax table that includes `_',
then execute BODY, and finally restore the old environment. Used for
consistent searching."
`(let ((case-fold-search t)) ; case insensitive search
,@body)))
(defmacro vhdl-prepare-search-2 (&rest body)
- "Enable case insensitive search, switch to syntax table that includes '_',
-and remove `intangible' overlays, then execute BODY, and finally restore the
-old environment. Used for consistent searching."
- ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef
+ "Enable case insensitive search, switch to syntax table that includes `_',
+arrange to ignore `intangible' overlays, then execute BODY, and finally restore
+the old environment. Used for consistent searching."
`(let ((case-fold-search t) ; case insensitive search
(current-syntax-table (syntax-table))
- overlay-all-list overlay-intangible-list overlay)
+ (inhibit-point-motion-hooks t))
;; use extended syntax table
(set-syntax-table vhdl-mode-ext-syntax-table)
- ;; remove `intangible' overlays
- (when (fboundp 'overlay-lists)
- (setq overlay-all-list (overlay-lists))
- (setq overlay-all-list
- (append (car overlay-all-list) (cdr overlay-all-list)))
- (while overlay-all-list
- (setq overlay (car overlay-all-list))
- (when (memq 'intangible (overlay-properties overlay))
- (setq overlay-intangible-list
- (cons overlay overlay-intangible-list))
- (overlay-put overlay 'intangible nil))
- (setq overlay-all-list (cdr overlay-all-list))))
;; execute BODY safely
(unwind-protect
(progn ,@body)
;; restore syntax table
- (set-syntax-table current-syntax-table)
- ;; restore `intangible' overlays
- (when (fboundp 'overlay-lists)
- (while overlay-intangible-list
- (overlay-put (car overlay-intangible-list) 'intangible t)
- (setq overlay-intangible-list
- (cdr overlay-intangible-list)))))))
+ (set-syntax-table current-syntax-table))))
(defmacro vhdl-visit-file (file-name issue-error &rest body)
"Visit file FILE-NAME and execute BODY."
(setq file-list (cdr file-list)))
dir-list))
-(defun vhdl-aput (alist-symbol key &optional value)
+(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
"As `aput', but delete key-value pair if VALUE is nil."
(if value
- (aput alist-symbol key value)
- (adelete alist-symbol key)))
+ (vhdl-aput alist-symbol key value)
+ (vhdl-adelete alist-symbol key)))
(defun vhdl-delete (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
(set-buffer (marker-buffer marker)))
(goto-char marker))
-(defun vhdl-goto-line (line)
- "Use this instead of calling user level function `goto-line'."
- (goto-char (point-min))
- (forward-line (1- line)))
-
(defun vhdl-menu-split (list title)
"Split menu LIST into several submenus, if number of
elements > `vhdl-menu-max-size'."
(define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
(define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
(define-key vhdl-template-map "co" 'vhdl-template-constant)
+ (define-key vhdl-template-map "ct" 'vhdl-template-context)
(define-key vhdl-template-map "di" 'vhdl-template-disconnect)
(define-key vhdl-template-map "el" 'vhdl-template-else)
(define-key vhdl-template-map "ei" 'vhdl-template-elsif)
(defun vhdl-function-name (prefix string &optional postfix)
"Generate a Lisp function name.
-PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in
+PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in
STRING are replaced by `-' and substrings are converted to lower case."
(let ((name prefix))
(while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
(modify-syntax-entry ?\* "." st)
(modify-syntax-entry ?\+ "." st)
(modify-syntax-entry ?\. "." st)
- (modify-syntax-entry ?\/ "." st)
+;;; (modify-syntax-entry ?\/ "." st)
(modify-syntax-entry ?\: "." st)
(modify-syntax-entry ?\; "." st)
(modify-syntax-entry ?\< "." st)
(modify-syntax-entry ?\" "\"" st)
;; define underscore
(modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
- ;; a single hyphen is punctuation, but a double hyphen starts a comment
- (modify-syntax-entry ?\- ". 12" st)
- ;; and \n and \^M end a comment
- (modify-syntax-entry ?\n ">" st)
- (modify-syntax-entry ?\^M ">" st)
+ ;; single-line comments
+ (modify-syntax-entry ?\- ". 12b" st)
+ ;; multi-line comments
+ (modify-syntax-entry ?\/ ". 14b" st)
+ (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?\n "> b" st)
+ (modify-syntax-entry ?\^M "> b" st)
;; define parentheses to match
(modify-syntax-entry ?\( "()" st)
(modify-syntax-entry ?\) ")(" st)
(make-variable-buffer-local 'vhdl-syntactic-context)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Abbrev ook bindings
+;; Abbrev hook bindings
(defvar vhdl-mode-abbrev-table nil
"Abbrev table to use in `vhdl-mode' buffers.")
(define-abbrev-table 'vhdl-mode-abbrev-table
(append
(when (memq 'vhdl vhdl-electric-keywords)
- ;; VHDL'93 keywords
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ ;; VHDL'02 keywords
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("--" . vhdl-template-display-comment-hook)
("abs" . vhdl-template-default-hook)
("configuration" . vhdl-template-configuration-hook)
("cons" . vhdl-template-constant-hook)
("constant" . vhdl-template-constant-hook)
+ ("context" . vhdl-template-context-hook)
("disconnect" . vhdl-template-disconnect-hook)
("downto" . vhdl-template-default-hook)
("else" . vhdl-template-else-hook)
)))
;; VHDL-AMS keywords
(when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("across" . vhdl-template-default-hook)
("break" . vhdl-template-break-hook)
("configuration declaration" vhdl-template-configuration-decl)
("configuration specification" vhdl-template-configuration-spec)
("constant declaration" vhdl-template-constant)
+ ("context declaration" vhdl-template-context)
("disconnection specification" vhdl-template-disconnect)
("entity declaration" vhdl-template-entity)
("exit statement" vhdl-template-exit)
["Configuration (Decl)" vhdl-template-configuration-decl t]
["Configuration (Spec)" vhdl-template-configuration-spec t]
["Constant" vhdl-template-constant t]
+ ["Context" vhdl-template-context t]
["Disconnect" vhdl-template-disconnect t]
["Else" vhdl-template-else t]
["Elsif" vhdl-template-elsif t]
(list '93 (cadr vhdl-standard)))
(vhdl-activate-customizations))
:style radio :selected (eq '93 (car vhdl-standard))]
+ ["VHDL'08"
+ (progn (customize-set-variable 'vhdl-standard
+ (list '08 (cadr vhdl-standard)))
+ (vhdl-activate-customizations))
+ :style radio :selected (eq '08 (car vhdl-standard))]
"--"
["VHDL-AMS"
(progn (customize-set-variable
(customize-set-variable 'vhdl-conditions-in-parenthesis
(not vhdl-conditions-in-parenthesis))
:style toggle :selected vhdl-conditions-in-parenthesis]
+ ["Sensitivity List uses 'all'"
+ (customize-set-variable 'vhdl-sensitivity-list-all
+ (not vhdl-sensitivity-list-all))
+ :style toggle :selected vhdl-sensitivity-list-all]
["Zero String..." (customize-option 'vhdl-zero-string) t]
["One String..." (customize-option 'vhdl-one-string) t]
("File Header"
("Entity"
"^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
2)
+ ("Context"
+ "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
+ 2)
)
"Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
TEMPLATE INSERTION (electrification):
After typing a VHDL keyword and entering `SPC', you are prompted for
arguments while a template is generated for that VHDL construct. Typing
- `RET' or `C-g' at the first \(mandatory) prompt aborts the current
+ `RET' or `C-g' at the first (mandatory) prompt aborts the current
template generation. Optional arguments are indicated by square
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
conf, comp, cons, func, inst, pack, sig, var.
Template styles can be customized in customization group
- `vhdl-template' \(see OPTIONS).
+ `vhdl-template' (see OPTIONS).
HEADER INSERTION:
;;; --> \" := \" [[ --> [ --CR --> comment-out code
.. --> \" => \" ] --> ) --- --> horizontal line
,, --> \" <= \" ]] --> ] ---- --> display comment
- == --> \" == \" '' --> \\\"
+ == --> \" == \" \\='\\=' --> \\\"
WORD COMPLETION:
Typing `TAB' after `(' looks for and inserts complete parenthesized
expressions (e.g. for array index ranges). All keywords as well as
standard types and subprograms of VHDL have predefined abbreviations
- \(e.g. type \"std\" and `TAB' will toggle through all standard types
+ (e.g., type \"std\" and `TAB' will toggle through all standard types
beginning with \"std\").
Typing `TAB' after a non-word character indents the line if at the
the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
- \(`M-C-\\') or the entire buffer (menu). Argument and port lists are
+ (`M-C-\\') or the entire buffer (menu). Argument and port lists are
indented normally (nil) or relative to the opening parenthesis (non-nil)
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
- and vice versa.
+ tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
+ tabs and vice versa.
Syntax-based indentation can be very slow in large files. Option
`vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
+ (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
KEYWORD CASE:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`M-x customize-group'). For
+ customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
Insert them once manually (will be kept afterwards).
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
- \(used to obtain the port names).
+ (used to obtain the port names).
Use option `vhdl-array-index-record-field-in-sensitivity-list' to
specify whether to include array indices and record fields in
sensitivity lists.
CODE FIXING:
`C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
- \(e.g. if the closing parenthesis is on the wrong line or is missing).
+ (e.g., if the closing parenthesis is on the wrong line or is missing).
PRINTING:
PostScript printing with different faces (an optimized set of faces is
- used if `vhdl-print-customize-faces' is non-nil) or colors \(if
+ used if `vhdl-print-customize-faces' is non-nil) or colors (if
`ps-print-color-p' is non-nil) is possible using the standard Emacs
PostScript printing commands. Option `vhdl-print-two-column' defines
appropriate default settings for nice landscape two-column printing.
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
- customize-group' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command `\\[customize-option]'
+ (`\\[customize-group]' for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`M-x vhdl-customize' or menu)!
+ what other useful user options there are (`\\[vhdl-customize]' or menu)!
FILE EXTENSIONS:
automatically recognized as VHDL source files. To add an extension
\".xxx\", add the following line to your Emacs start-up file (`.emacs'):
- \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
+ (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist)
HINTS:
Maintenance:
------------
-To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
+To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
;; set local variables
(set (make-local-variable 'paragraph-start)
- "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
+ "\\s-*\\(--+\\s-*$\\|$\\)")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
(set (make-local-variable 'comment-start) "--")
(set (make-local-variable 'comment-end) "")
- (when vhdl-emacs-21
- (set (make-local-variable 'comment-padding) ""))
(set (make-local-variable 'comment-column) vhdl-inline-comment-column)
(set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
(set (make-local-variable 'comment-start-skip) "--+\\s-*")
(syntax-propertize-rules
;; Mark single quotes as having string quote syntax in
;; 'c' instances.
- ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
+ ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
(set (make-local-variable 'font-lock-syntactic-keywords)
vhdl-font-lock-syntactic-keywords))
(unless vhdl-emacs-21
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
(set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
-; (set (make-local-variable 'lazy-lock-defer-time) 0.1)
(set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
-; (turn-on-font-lock)
;; variables for source file compilation
(when vhdl-compile-use-local-error-regexp
)
"List of VHDL'02 keywords.")
+(defconst vhdl-08-keywords
+ '(
+ "context" "force" "property" "release" "sequence"
+ )
+ "List of VHDL'08 keywords.")
+
(defconst vhdl-ams-keywords
'(
"across" "break" "limit" "nature" "noise" "procedural" "quantity"
)
"List of VHDL'02 standardized types.")
+(defconst vhdl-08-types
+ '(
+ "boolean_vector" "integer_vector" "real_vector" "time_vector"
+ )
+ "List of VHDL'08 standardized types.")
+
(defconst vhdl-ams-types
;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
'(
)
"List of VHDL'02 standardized attributes.")
+(defconst vhdl-08-attributes
+ '(
+ "instance_name" "path_name"
+ )
+ "List of VHDL'08 standardized attributes.")
+
(defconst vhdl-ams-attributes
'(
"across" "through"
)
"List of VHDL'02 standardized functions.")
+(defconst vhdl-08-functions
+ '(
+ "finish" "flush" "justify" "maximum" "minimum"
+ "resolution_limit" "rising_edge" "stop" "swrite"
+ "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
+ "to_octalstring" "to_ostring" "to_string"
+ )
+ "List of VHDL'08 standardized functions.")
+
(defconst vhdl-ams-functions
'(
;; package `standard'
)
"List of VHDL'02 standardized packages and libraries.")
+(defconst vhdl-08-packages
+ '(
+ "env" "numeric_std_signed" "numeric_std_unsigned"
+ "ieee_bit_context" "ieee_std_context" ;; contexts
+ )
+ "List of VHDL'08 standardized packages and libraries.")
+
(defconst vhdl-ams-packages
'(
"fundamental_constants" "material_constants" "energy_systems"
)
"List of Math Packages standardized packages and libraries.")
+(defconst vhdl-08-directives
+ '(
+ "author" "author_info" "begin" "begin_protected" "comment"
+ "data_block" "data_keyname" "data_keyowner" "data_method"
+ "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
+ "digest_keyowner" "digest_method"
+ "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
+ "key_block" "key_keyname" "key_keyowner" "key_method"
+ "runtime_license" "viewport"
+ )
+ "List of VHDL'08 standardized tool directives.")
+
(defvar vhdl-keywords nil
"List of VHDL keywords.")
(defvar vhdl-packages nil
"List of VHDL standardized packages and libraries.")
+(defvar vhdl-directives nil
+ "List of VHDL standardized packages and libraries.")
+
(defvar vhdl-reserved-words nil
"List of additional reserved words.")
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
(append vhdl-02-keywords
+ (when (vhdl-standard-p '08) vhdl-08-keywords)
(when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
(setq vhdl-types
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-types)
(append vhdl-02-types
+ (when (vhdl-standard-p '08) vhdl-08-types)
(when (vhdl-standard-p 'ams) vhdl-ams-types)
(when (vhdl-standard-p 'math) vhdl-math-types))))
(setq vhdl-attributes
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
(append vhdl-02-attributes
+ (when (vhdl-standard-p '08) vhdl-08-attributes)
(when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
(setq vhdl-enum-values
(vhdl-upcase-list
'(""))))
(setq vhdl-functions
(append vhdl-02-functions
+ (when (vhdl-standard-p '08) vhdl-08-functions)
(when (vhdl-standard-p 'ams) vhdl-ams-functions)
(when (vhdl-standard-p 'math) vhdl-math-functions)))
(setq vhdl-packages
(append vhdl-02-packages
+ (when (vhdl-standard-p '08) vhdl-08-packages)
(when (vhdl-standard-p 'ams) vhdl-ams-packages)
(when (vhdl-standard-p 'math) vhdl-math-packages)))
+ (setq vhdl-directives
+ (append (when (vhdl-standard-p '08) vhdl-08-directives)))
(setq vhdl-reserved-words
(append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
(when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
(list vhdl-upper-case-enum-values) vhdl-enum-values
(list vhdl-upper-case-constants) vhdl-constants
(list nil) vhdl-functions
- (list nil) vhdl-packages)))
+ (list nil) vhdl-packages
+ (list nil) vhdl-directives)))
;; initialize reserved words for VHDL Mode
(vhdl-words-init)
;; Syntactic support functions:
-(defun vhdl-in-comment-p ()
- "Check if point is in a comment."
- (eq (vhdl-in-literal) 'comment))
+(defun vhdl-in-comment-p (&optional pos)
+ "Check if point is in a comment (include multi-line comments)."
+ (let ((parse (lambda (p)
+ (let ((c (char-after p)))
+ (or (and c (eq (char-syntax c) ?<))
+ (nth 4 (parse-partial-sexp
+ (save-excursion
+ (beginning-of-defun)
+ (point)) p)))))))
+ (save-excursion
+ (goto-char (or pos (point)))
+ (or (funcall parse (point))
+ ;; `parse-partial-sexp's notion of comments doesn't span lines
+ (progn
+ (back-to-indentation)
+ (unless (eolp)
+ (forward-char)
+ (funcall parse (point))))))))
(defun vhdl-in-string-p ()
"Check if point is in a string."
((nth 3 state) 'string)
((nth 4 state) 'comment)
((vhdl-beginning-of-macro) 'pound)
+ ((vhdl-beginning-of-directive) 'directive)
+ ;; for multi-line comments
+ ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
(t nil)))))
(defun vhdl-in-extended-identifier-p ()
- "Determine if point is inside extended identifier (delimited by '\')."
+ "Determine if point is inside extended identifier (delimited by `\\')."
(save-match-data
(and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
(save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
(goto-char lim )
(while (< (point) here)
(setq match
- (and (re-search-forward "--\\|[\"']"
+ (and (re-search-forward "--\\|[\"']\\|`"
here 'move)
(buffer-substring (match-beginning 0) (match-end 0))))
(setq state
;; looking at the opening of a VHDL style comment
((string= "--" match)
(if (<= here (progn (end-of-line) (point))) 'comment))
+ ;; looking at a directive
+ ((string= "`" match)
+ (if (<= here (progn (end-of-line) (point))) 'directive))
;; looking at the opening of a double quote string
((string= "\"" match)
(if (not (save-restriction
(setq here (point))
(vhdl-forward-comment hugenum)
;; skip preprocessor directives
- (when (and (eq (char-after) ?#)
+ (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
(= (vhdl-point 'boi) (point)))
(while (and (eq (char-before (vhdl-point 'eol)) ?\\)
(= (forward-line 1) 0)))
(goto-char here)
nil)))
+(defun vhdl-beginning-of-directive (&optional lim)
+ "Go to the beginning of a directive (nicked from `cc-engine')."
+ (let ((here (point)))
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (forward-line -1))
+ (back-to-indentation)
+ (if (and (<= (point) here)
+ (eq (char-after) ?`))
+ t
+ (goto-char here)
+ nil)))
+
(defun vhdl-backward-syntactic-ws (&optional lim)
"Backward skip over syntactic whitespace."
(let* ((here (point-min))
;; Core syntactic evaluation functions:
(defconst vhdl-libunit-re
- "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
+ "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
(defun vhdl-libunit-p ()
(and
))
(defconst vhdl-defun-re
- "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
+ "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
(defun vhdl-defun-p ()
(save-excursion
(save-excursion
(backward-sexp)
(not (looking-at "end\\s-+\\w")))
- ;; "architecture", "configuration", "entity",
+ ;; "architecture", "configuration", "context", "entity",
;; "package", "procedure", "function":
t)))
(if (looking-at "block\\|process\\|procedural")
;; "block", "process". "procedural:
(buffer-substring (match-beginning 0) (match-end 0))
- ;; "architecture", "configuration", "entity", "package",
+ ;; "architecture", "configuration", "context", "entity", "package",
;; "procedure", "function":
"is"))))
the middle of an identifier that just happens to contain a \"begin\"
keyword."
(cond
- ;; "[architecture|case|configuration|entity|package|
+ ;; "[architecture|case|configuration|context|entity|package|
;; procedure|function] ... is":
((and (looking-at "i")
(save-excursion
;; following search list so that we don't run into
;; semicolons in the function interface list.
(backward-sexp)
+ (skip-chars-forward "(")
(let (foundp)
(while (and (not foundp)
(re-search-backward
- ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
+ ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
lim 'move))
(if (or (= (preceding-char) ?_)
(vhdl-in-literal))
(vector "for" (vhdl-first-word pos) nil nil))
;; "end [id]":
(t
- (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
+ (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
(vhdl-first-word pos)
;; return an alist of (statement . keyword) mappings
'(
("architecture" . "is")
;; "configuration ... is ... end [id]":
("configuration" . "is")
+ ;; "context ... is ... end [id]":
+ ("context" . "is")
;; "entity ... is ... end [id]":
("entity" . "is")
;; "package ... is ... end [id]":
;; keyword, allow for the keyword and an extra character,
;; as this will be used when looking forward for the
;; "begin" keyword.
- (save-excursion (forward-word 1) (1+ (point))))
+ (save-excursion (forward-word-strictly 1) (1+ (point))))
foundp literal placeholder)
;; Find the "libunit" keyword.
(while (and (not foundp)
;; keyword, allow for the keyword and an extra character,
;; as this will be used when looking forward for the
;; "begin" keyword.
- (save-excursion (forward-word 1) (1+ (point))))
+ (save-excursion (forward-word-strictly 1) (1+ (point))))
begin-string literal)
(while (and (not foundp)
(re-search-backward vhdl-defun-re nil 'move))
(re-search-forward vhdl-e-o-s-re))
(defconst vhdl-b-o-s-re
- (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
+ (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|"
vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
(defun vhdl-beginning-of-statement-1 (&optional lim)
;; start point was not inside leader area
;; set stop point at word after leader
(setq pos (point))))
- (forward-word 1)
+ (unless (looking-at "\\<else\\s-+generate\\>")
+ (forward-word-strictly 1))
(vhdl-forward-syntactic-ws here)
(setq pos (point)))
(goto-char pos)
(cond
((looking-at "e") 'entity)
((looking-at "a") 'architecture)
- ((looking-at "c") 'configuration)
+ ((looking-at "conf") 'configuration)
+ ((looking-at "cont") 'context)
((looking-at "p")
(save-excursion
(goto-char bod)
(goto-char (1+ containing-sexp))
(skip-chars-forward " \t")
(not (eolp))
- (not (looking-at "--")))
+ (not (looking-at "--\\|`")))
(save-excursion
(vhdl-beginning-of-statement-1 containing-sexp)
(skip-chars-backward " \t(")
;; now we need to look at any modifiers
(goto-char indent-point)
(skip-chars-forward " \t")
- (if (looking-at "--")
+ (if (or (looking-at "--") (looking-at "/\\*"))
(vhdl-add-syntax 'comment))
+ (if (looking-at "`")
+ (vhdl-add-syntax 'directive))
(if (eq literal 'pound)
(vhdl-add-syntax 'cpp-macro))
;; return the syntax
(vhdl-comment-indent)
;; otherwise, indent as specified by vhdl-comment-only-line-offset
(if (not (bolp))
+ ;; inside multi-line comment
+ (if (looking-at "\\*")
+ 1
+ ;; otherwise
(or (car-safe vhdl-comment-only-line-offset)
- vhdl-comment-only-line-offset)
+ vhdl-comment-only-line-offset))
(or (cdr-safe vhdl-comment-only-line-offset)
(car-safe vhdl-comment-only-line-offset)
-1000 ;jam it against the left side
(- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
(let ((delta (- (aref vhdl-progress-info 1)
(aref vhdl-progress-info 0))))
- (if (= 0 delta)
- (message (concat string "... (100%s)") "%")
- (message (concat string "... (%2d%s)")
- (/ (* 100 (- pos (aref vhdl-progress-info 0)))
- delta) "%")))
+ (message "%s... (%2d%%)" string
+ (if (= 0 delta)
+ 100
+ (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
+ delta))))
(aset vhdl-progress-info 2 (nth 1 (current-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(mapc
(function
(lambda (elt)
- (if (memq (car elt) '(entity configuration package
+ (if (memq (car elt) '(entity configuration context package
package-body architecture))
nil
(setq expurgated (append expurgated (list elt))))))
(setq end (point-marker))
(goto-char begin)
(setq bol (setq begin (progn (beginning-of-line) (point))))
-; (untabify bol end)
(when indent
(indent-region bol end nil))))
(let ((copy (copy-alist alignment-list)))
(vhdl-prepare-search-2
(save-excursion
;; search for declarative part
- (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
+ (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
(not (member (upcase (match-string 1)) '("BEGIN" "END"))))
(setq beg (point))
(re-search-forward "^\\(begin\\|end\\)\\>" nil t)
(setq end (point-marker))
;; have no space before and one space after `,' and ';'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\3 " nil nil nil 2)))
;; have no space after `('
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; have no space before `)'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; surround operator symbols by one space
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
(if (or (match-string 1)
(<= (match-beginning 0) ; not if at boi
(save-excursion (back-to-indentation) (point))))
(and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
(progn (replace-match " " nil nil) t))
(and (looking-at "-") (re-search-forward "-" end t))
-; (re-search-forward "[^ \t-]+" end t))))
(re-search-forward "[^ \t\"-]+" end t))))
(unless no-message (message "Fixing up whitespace...done")))
(defun vhdl-fix-statement-region (beg end &optional arg)
"Force statements in region on separate line except when on same line
-with 'end' keyword (necessary for correct indentation).
-Currently supported keywords: 'begin', 'if'."
+with `end' keyword (necessary for correct indentation).
+Currently supported keywords: `begin', `if'."
(interactive "r\nP")
(vhdl-prepare-search-2
(let (point)
(while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
(goto-char (match-end 1))
(setq point (point-marker))
- ;; exception: in literal or preceded by `end' or label
+ ;; exception: in literal or preceded by `end', `wait' or label
(when (and (not (save-excursion (goto-char (match-beginning 1))
(vhdl-in-literal)))
(save-excursion
(and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
(match-beginning 1) t)
(not (string-match
- "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$"
+ "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
(match-string 1)))))))
(goto-char (match-beginning 1))
(insert "\n")
(defun vhdl-fix-statement-buffer ()
"Force statements in buffer on separate line except when on same line
-with 'end' keyword (necessary for correct indentation)."
+with `end' keyword (necessary for correct indentation)."
(interactive)
(vhdl-fix-statement-region (point-min) (point-max)))
(setq end (save-excursion (goto-char end) (point-marker)))
(save-excursion ; remove DOS EOL characters in UNIX file
(goto-char beg)
- (while (search-forward "\r" nil t)
+ (while (search-forward "\r" nil t)
(replace-match "" nil t)))
(when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
(when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
(when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
- (let ((vhdl-align-groups t))
- (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end)))
+ (when (nth 3 vhdl-beautify-options)
+ (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
(when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
- (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end)))
+ (when (nth 0 vhdl-beautify-options)
+ (vhdl-remove-trailing-spaces-region beg end)
+ (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
(defun vhdl-beautify-buffer ()
"Beautify buffer by applying indentation, whitespace fixup, alignment, and
(setq end (vhdl-re-search-forward "\\<then\\>" proc-end t))
(when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
(goto-char end)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-forward-sexp)
(push (cons end (point)) seq-region-list)
(beginning-of-line)))
(setq beg (point))))))
;; search for signals declared in surrounding block declarative parts
(save-excursion
- (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
- (match-string 2))
- (goto-char (match-end 2))
+ (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
+ (match-string 4))
+ (goto-char (match-end 4))
(vhdl-backward-sexp)
- (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
+ (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
beg)
(setq end (re-search-forward "^\\s-*begin\\>" nil t)))
;; scan for all declared signal names
"Return the working library name of the current project or \"work\" if no
project is defined."
(vhdl-resolve-env-variable
- (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
+ (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
+ vhdl-default-library)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Enabling/disabling
(let ((next-input (read-char)))
(if (= next-input ?-) ; four dashes
(vhdl-comment-display t)
- (setq unread-command-events ; pushback the char
- (list (vhdl-character-to-event next-input))))))
- (setq unread-command-events ; pushback the char
- (list (vhdl-character-to-event next-input)))
+ (push (vhdl-character-to-event next-input)
+ ; pushback the char
+ unread-command-events))))
+ (push (vhdl-character-to-event next-input) ; pushback the char
+ unread-command-events)
(vhdl-comment-insert)))))
(self-insert-command count)))
-(defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
+(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(if (= (preceding-char) ?\()
(insert-char ?\( 1))
(self-insert-command count)))
-(defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
+(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(progn
(blink-matching-open))
(self-insert-command count)))
-(defun vhdl-electric-quote (count) "'' --> \""
+(defun vhdl-electric-quote (count) "\\='\\=' --> \""
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(if (= (preceding-char) vhdl-last-input-event)
(insert-char ?\' 1))
(self-insert-command count)))
-(defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
+(defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
(t (insert-char ?\; 1)))
(self-insert-command count)))
-(defun vhdl-electric-comma (count) "',,' --> ' <= '"
+(defun vhdl-electric-comma (count) "`,,' --> ` <= '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
(t (insert-char ?\, 1)))
(self-insert-command count)))
-(defun vhdl-electric-period (count) "'..' --> ' => '"
+(defun vhdl-electric-period (count) "`..' --> ` => '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
(t (insert-char ?\. 1)))
(self-insert-command count)))
-(defun vhdl-electric-equal (count) "'==' --> ' == '"
+(defun vhdl-electric-equal (count) "`==' --> ` == '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
(vhdl-insert-keyword ": BLOCK ")
(goto-char start)
(when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1)
(insert "(")
(if (vhdl-template-field "[guard expression]" nil t)
(if (vhdl-template-field "[quantity name]" " USE " t)
(progn (vhdl-template-field "quantity name" " => ") t)
(delete-region (point)
- (progn (forward-word -1) (point)))
+ (progn (forward-word-strictly -1) (point)))
nil))
(vhdl-template-field "[quantity name]" " => " t))
(vhdl-template-field "expression")
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(when (vhdl-template-field "expression" nil t start (point))
(vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
(interactive)
(when (vhdl-template-field "target signal")
(insert " <= ")
-; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
-; (insert " "))
(let ((margin (current-column))
(start (point))
position)
(insert ";")
(vhdl-comment-insert-inline))))))
+(defun vhdl-template-context ()
+ "Insert a context declaration."
+ (interactive)
+ (let ((margin (current-indentation))
+ (start (point))
+ entity-exists string name position)
+ (vhdl-insert-keyword "CONTEXT ")
+ (when (setq name (vhdl-template-field "name" nil t start (point)))
+ (vhdl-insert-keyword " IS\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to (+ margin vhdl-basic-offset))
+ (setq position (point))
+ (insert "\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to margin)
+ (vhdl-insert-keyword "END ")
+ (unless (vhdl-standard-p '87)
+ (vhdl-insert-keyword "CONTEXT "))
+ (insert name ";")
+ (goto-char position))))
+
(defun vhdl-template-default ()
"Insert nothing."
(interactive)
(insert " ")
(unexpand-abbrev)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-case-word 1)
(forward-char 1))
(interactive)
(insert " ")
(unexpand-abbrev)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-case-word 1)
(forward-char 1)
(indent-according-to-mode))
(let (margin)
(vhdl-prepare-search-1
(vhdl-insert-keyword "ELSE")
- (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
- (equal "WHEN" (upcase (match-string 1))))
+ (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t))
+ (match-string 2))
(insert " ")
+ (unless (vhdl-sequential-statement-p)
+ (vhdl-insert-keyword " GENERATE"))
(indent-according-to-mode)
(setq margin (current-indentation))
(insert "\n")
(let ((start (point))
margin)
(vhdl-insert-keyword "ELSIF ")
- (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
(when vhdl-conditions-in-parenthesis (insert "("))
(when (vhdl-template-field "condition" nil t start (point))
(when vhdl-conditions-in-parenthesis (insert ")"))
(indent-according-to-mode)
(setq margin (current-indentation))
(vhdl-insert-keyword
- (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
- (indent-to (+ margin vhdl-basic-offset))))))
+ (concat " " (cond ((vhdl-sequential-statement-p) "THEN")
+ ((vhdl-standard-p 'ams) "USE")
+ (t "GENERATE")) "\n"))
+ (indent-to (+ margin vhdl-basic-offset)))))
(defun vhdl-template-entity ()
"Insert an entity."
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(when (setq index (vhdl-template-field "loop variable"
nil t start (point)))
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(when vhdl-conditions-in-parenthesis (insert "("))
(when (vhdl-template-field "condition" nil t start (point))
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(delete-char 1))
(insert "\n\n")
(indent-to margin)
(cond ((equal definition "")
(insert ";"))
((equal definition "ARRAY")
- (delete-region (point) (progn (forward-word -1) (point)))
+ (delete-region (point) (progn (forward-word-strictly -1)
+ (point)))
(vhdl-template-array 'nature t))
((equal definition "RECORD")
(setq mid-pos (point-marker))
- (delete-region (point) (progn (forward-word -1) (point)))
+ (delete-region (point) (progn (forward-word-strictly -1)
+ (point)))
(vhdl-template-record 'nature name t))
(t
(vhdl-insert-keyword " ACROSS ")
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
(insert "\n")
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(insert "(")
(if (not seq)
- (unless (setq input-signals
- (vhdl-template-field "[sensitivity list]" ")" t))
+ (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
+ (progn (insert "all)") (setq input-signals "all")))
+ (setq input-signals
+ (vhdl-template-field "[sensitivity list]" ")" t)))
(setq input-signals "")
(delete-char -2))
(setq clock (or (and (not (equal "" vhdl-clock-name))
(defun vhdl-template-record (kind &optional name secondary)
"Insert a record type declaration."
(interactive)
- (let ((margin (current-column))
+ (let ((margin (current-indentation))
(start (point))
(first t))
(vhdl-insert-keyword "RECORD\n")
(vhdl-insert-keyword "WITH ")
(when (vhdl-template-field "selector expression"
nil t start (+ (point) 7))
- (forward-word 1)
+ (forward-word-strictly 1)
(delete-char 1)
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "target signal" " <= ")
-; (vhdl-template-field "[GUARDED] [TRANSPORT]")
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "waveform")
(delete-char -4)
(insert ";"))
((equal definition "ARRAY")
- (delete-region (point) (progn (forward-word -1) (point)))
+ (delete-region (point) (progn (forward-word-strictly -1)
+ (point)))
(vhdl-template-array 'type t))
((equal definition "RECORD")
(setq mid-pos (point-marker))
- (delete-region (point) (progn (forward-word -1) (point)))
+ (delete-region (point) (progn (forward-word-strictly -1)
+ (point)))
(vhdl-template-record 'type name t))
((equal definition "ACCESS")
(insert " ")
(if (or (save-excursion
(progn (vhdl-beginning-of-block)
(looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
- (save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
+ (save-excursion (backward-word-strictly 1)
+ (looking-at "\\<shared\\>")))
(vhdl-insert-keyword "VARIABLE ")
(if (vhdl-standard-p '87)
(error "ERROR: Not within sequential block")
(goto-char start)
(setq label (vhdl-template-field "[label]" nil t))
(unless label (delete-char 2))
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 1))
(when vhdl-conditions-in-parenthesis (insert "("))
(when (vhdl-template-field "condition" nil t start (point))
(insert "-- pragma " directive))
(defun vhdl-template-directive-translate-on ()
- "Insert directive 'translate_on'."
+ "Insert directive `translate_on'."
(interactive)
(vhdl-template-directive "translate_on"))
(defun vhdl-template-directive-translate-off ()
- "Insert directive 'translate_off'."
+ "Insert directive `translate_off'."
(interactive)
(vhdl-template-directive "translate_off"))
(defun vhdl-template-directive-synthesis-on ()
- "Insert directive 'synthesis_on'."
+ "Insert directive `synthesis_on'."
(interactive)
(vhdl-template-directive "synthesis_on"))
(defun vhdl-template-directive-synthesis-off ()
- "Insert directive 'synthesis_off'."
+ "Insert directive `synthesis_off'."
(interactive)
(vhdl-template-directive "synthesis_off"))
(defun vhdl-template-replace-header-keywords (beg end &optional file-title
is-model)
"Replace keywords in header and footer."
- (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
- (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
+ (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
+ (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
pos)
(vhdl-prepare-search-2
(save-excursion
(while (search-forward "<standard>" end t)
(replace-match
(concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
- ((vhdl-standard-p '93) "'93/02"))
+ ((vhdl-standard-p '93) "'93/02")
+ ((vhdl-standard-p '08) "'08"))
(when (vhdl-standard-p 'ams) ", VHDL-AMS")
(when (vhdl-standard-p 'math) ", Math Packages")) t t))
(goto-char beg)
(replace-match file-title t t))
(goto-char beg))
(let (string)
- (while
- (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
- (setq string (read-string (concat (match-string 1) ": ")))
+ (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
+ (save-match-data
+ (setq string (read-string (concat (match-string 1) ": "))))
(replace-match string t t)))
(goto-char beg)
(when (and (not is-model) (search-forward "<cursor>" end t))
(setq code t))
(unless code
(insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
- (setq unread-command-events
- (list (vhdl-character-to-event next-input)))))) ; pushback the char
+ (push (vhdl-character-to-event next-input) ; pushback the char
+ unread-command-events))))
(defun vhdl-comment-display (&optional line-exists)
"Add 2 comment lines at the current indent, making a display comment."
(if (not (or (and string (progn (insert string) t))
(vhdl-template-field "[comment]" nil t)))
(delete-region position (point))
- (while (= (preceding-char) ?\ ) (delete-char -1))
- ;; (when (> (current-column) end-comment-column)
- ;; (setq position (point-marker))
- ;; (re-search-backward "-- ")
- ;; (insert "\n")
- ;; (indent-to comment-column)
- ;; (goto-char position))
- ))))
+ (while (= (preceding-char) ?\ ) (delete-char -1))))))
(defun vhdl-comment-block ()
"Insert comment for code block."
(defun vhdl-template-generate-body (margin label)
"Insert body for generate template."
(vhdl-insert-keyword " GENERATE")
-; (if (not (vhdl-standard-p '87))
-; (vhdl-template-begin-end "GENERATE" label margin)
(insert "\n\n")
(indent-to margin)
(vhdl-insert-keyword "END GENERATE ")
(save-excursion
(beginning-of-line)
;; search backward for block beginning or end
- (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
;; not consider subprogram declarations
(or (and (match-string 5)
(save-match-data
(save-excursion
(goto-char (match-end 5))
- (forward-word 1)
+ (forward-word-strictly 1)
(vhdl-forward-syntactic-ws)
(when (looking-at "(")
(forward-sexp))
(save-excursion
(end-of-line)
;; search forward for block beginning or end
- (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
;; not consider subprogram declarations
(or (and (match-string 5)
(save-match-data
but not if inside a comment or quote."
(if (or (vhdl-in-literal)
(save-excursion
- (forward-word -1)
+ (forward-word-strictly -1)
(and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
(progn
(insert " ")
(unexpand-abbrev)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-case-word 1)
(delete-char 1))
(if (not vhdl-electric-mode)
(progn
(insert " ")
(unexpand-abbrev)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-case-word 1)
(delete-char 1))
(let ((invoke-char vhdl-last-input-event)
;; delete CR which is still in event queue
(if (fboundp 'enqueue-eval-event)
(enqueue-eval-event 'delete-char -1)
- (setq unread-command-events ; push back a delete char
- (list (vhdl-character-to-event ?\177))))))))
+ (push (vhdl-character-to-event ?\177) ; push back a delete char
+ unread-command-events))))))
(defun vhdl-template-alias-hook ()
(vhdl-hooked-abbrev 'vhdl-template-alias))
(vhdl-hooked-abbrev 'vhdl-template-configuration))
(defun vhdl-template-constant-hook ()
(vhdl-hooked-abbrev 'vhdl-template-constant))
+(defun vhdl-template-context-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-context))
(defun vhdl-template-disconnect-hook ()
(vhdl-hooked-abbrev 'vhdl-template-disconnect))
(defun vhdl-template-display-comment-hook ()
(equal "END" (upcase (match-string 1))))
(throw 'parse "ERROR: Not within an entity or component declaration"))
(setq decl-type (downcase (match-string-no-properties 1)))
- (forward-word 1)
+ (forward-word-strictly 1)
(vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
(setq name (match-string-no-properties 1))
(message "Reading port of %s \"%s\"..." decl-type name)
comment group-comment))))
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))))
-; (vhdl-parse-string "end\\>")
;; parse context clause
(setq context-clause (vhdl-scan-context-clause))
; ;; add surrounding package to context clause
(save-excursion
(re-search-backward
(concat "^\\s-*use\\s-+" (car clause)
- "\." (cdr clause) "\\>") nil t)))
+ "." (cdr clause) "\\>") nil t)))
(vhdl-template-standard-package (car clause) (cdr clause))
(insert "\n"))
(setq clause-list (cdr clause-list)))))
(insert name))
((equal (cdr vhdl-instance-name) "")
(setq name (vhdl-template-field "instance name")))
- ((string-match "\%d" (cdr vhdl-instance-name))
+ ((string-match "%d" (cdr vhdl-instance-name))
(let ((n 1))
(while (save-excursion
(setq name (format (vhdl-replace-string
(while (and he-expand-list
(or (not (stringp (car he-expand-list)))
(he-string-member (car he-expand-list) he-tried-table t)))
-; (equal (car he-expand-list) he-search-string)))
(unless (stringp (car he-expand-list))
(setq vhdl-expand-upper-case (car he-expand-list)))
(setq he-expand-list (cdr he-expand-list)))
# empty lines : %5d\n\
# comment lines : %5d\n\
# comments : %5d\n\
-# total lines : %5d\n\ "
+# total lines : %5d\n"
(buffer-file-name) no-stats no-code-lines no-empty-lines
no-comm-lines no-comments no-lines)
(unless vhdl-emacs-21 (vhdl-show-messages))))
(let (pos)
(save-excursion
(while (and (setq pos (re-search-forward regexp bound noerror count))
- (vhdl-in-literal))))
+ (save-match-data (vhdl-in-literal)))))
(when pos (goto-char pos))
pos))
(let (pos)
(save-excursion
(while (and (setq pos (re-search-backward regexp bound noerror count))
- (vhdl-in-literal))))
+ (save-match-data (vhdl-in-literal)))))
(when pos (goto-char pos))
pos))
";; project name\n"
"(setq vhdl-project \"" vhdl-project "\")\n\n"
";; project setup\n"
- "(aput 'vhdl-project-alist vhdl-project\n'")
- (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
+ "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
+ (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
(insert ")\n")
(save-buffer)
(kill-buffer (current-buffer))
(condition-case ()
(let ((current-project vhdl-project))
(load-file file-name)
- (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
- (adelete 'vhdl-project-alist vhdl-project)
+ (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10)
+ (vhdl-adelete 'vhdl-project-alist vhdl-project)
(error ""))
- (when not-make-current
- (setq vhdl-project current-project))
+ (if not-make-current
+ (setq vhdl-project current-project)
+ (setq vhdl-compiler
+ (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project)))))
(vhdl-update-mode-menu)
(vhdl-speedbar-refresh)
(unless not-make-current
- (message "Current VHDL project: \"%s\"%s"
- vhdl-project (if auto " (auto-loaded)" ""))))
+ (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s"
+ vhdl-project vhdl-compiler (if auto " (auto-loaded)" ""))))
(error (vhdl-warning
(format "ERROR: Invalid project setup file: \"%s\"" file-name))))))
"Duplicate setup of current project."
(interactive)
(let ((new-name (read-from-minibuffer "New project name: "))
- (project-entry (aget vhdl-project-alist vhdl-project t)))
+ (project-entry (vhdl-aget vhdl-project-alist vhdl-project)))
(setq vhdl-project-alist
(append vhdl-project-alist
(list (cons new-name project-entry))))
(vhdl-resolve-env-variable
(vhdl-replace-string
(cons "\\(.*\\) \\(.*\\)" (car file-name-list))
- (concat "\*" " " (user-login-name)))))))
+ (concat "* " (user-login-name)))))))
(setq list-length (or list-length (length file-list)))
(setq file-name-list (cdr file-name-list)))
(while file-list
;; subprogram body
(when (match-string 2)
(re-search-forward "^\\s-*\\<begin\\>" nil t)
- (backward-word 1)
+ (backward-word-strictly 1)
(vhdl-forward-sexp)))
;; block (recursive)
((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
(re-search-forward "^\\s-*end\\s-+process\\>" nil t))
;; configuration declaration
((looking-at "^\\s-*configuration\\>")
- (forward-word 4)
+ (forward-word-strictly 4)
(vhdl-forward-sexp))
(t (goto-char pos))))))
;; Syntax definitions
(defconst vhdl-font-lock-syntactic-keywords
- '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
- "Mark single quotes as having string quote syntax in 'c' instances.")
+ '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
+ "Mark single quotes as having string quote syntax in `c' instances.")
(defvar vhdl-font-lock-keywords nil
"Regular expressions to highlight in VHDL Mode.")
(list
(concat
"^\\s-*\\("
- "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
+ "architecture\\|configuration\\|context\\|entity\\|package"
+ "\\(\\s-+body\\)?\\|"
"\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
"\\)\\s-+\\(\\w+\\)")
5 'font-lock-function-name-face)
(list
(concat
"^\\s-*end\\s-+\\(\\("
- "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
- "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
- "procedure\\|\\(postponed\\s-+\\)?process\\|"
+ "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
+ "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
+ "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
(when (vhdl-standard-p 'ams) "procedural\\|")
"units"
"\\)\\s-+\\)?\\(\\w*\\)")
;; highlight names in use clauses
(list
(concat
- "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
+ "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
"\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
- '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
- '(7 font-lock-function-name-face nil t))
+ '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
+ '(8 font-lock-function-name-face nil t))
;; highlight attribute name in attribute declarations/specifications
(list
(skip-syntax-backward " ")
(skip-syntax-backward "w_")
(skip-syntax-backward " ")))
-; (skip-chars-backward "^-(\n\";")
(goto-char (match-end 1)) (1 font-lock-variable-name-face)))
;; highlight formal parameters in component instantiations and subprogram
'(vhdl-font-lock-match-item
(progn (goto-char (match-end 1)) (match-beginning 2))
nil (1 font-lock-variable-name-face)))
+
+ ;; highlight tool directives
+ (list
+ (concat
+ "^\\s-*\\(`\\w+\\)")
+ 1 'font-lock-preprocessor-face)
)
"For consideration as a value of `vhdl-font-lock-keywords'.
This does context sensitive highlighting of names and labels.")
"Return position of end of current unit."
(let ((pos (point)))
(save-excursion
- (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
+ (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
(save-excursion
(goto-char (match-beginning 0))
(vhdl-backward-syntactic-ws)
"Scan the context clause that precedes a design unit."
(let (lib-alist)
(save-excursion
- (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
+ (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t)
(while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
(equal "USE" (upcase (match-string 1))))
(when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
non-final)
"Scan contents of VHDL files in directory or file pattern NAME."
(string-match "\\(.*[/\\]\\)\\(.*\\)" name)
-; (unless (file-directory-p (match-string 1 name))
-; (message "No such directory: \"%s\"" (match-string 1 name)))
(let* ((dir-name (match-string 1 name))
(file-pattern (match-string 2 name))
(is-directory (= 0 (length file-pattern)))
dir-name t (wildcard-to-regexp file-pattern)))))
(key (or project dir-name))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
(limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
(limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
(limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
ent-alist conf-alist pack-alist ent-inst-list file-alist
tmp-list tmp-entry no-files files-exist big-files)
(when (or project update)
- (setq ent-alist (aget vhdl-entity-alist key t)
- conf-alist (aget vhdl-config-alist key t)
- pack-alist (aget vhdl-package-alist key t)
- ent-inst-list (car (aget vhdl-ent-inst-alist key t))
- file-alist (aget vhdl-file-alist key t)))
+ (setq ent-alist (vhdl-aget vhdl-entity-alist key)
+ conf-alist (vhdl-aget vhdl-config-alist key)
+ pack-alist (vhdl-aget vhdl-package-alist key)
+ ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key))
+ file-alist (vhdl-aget vhdl-file-alist key)))
(when (and (not is-directory) (null file-list))
(message "No such file: \"%s\"" name))
(setq files-exist file-list)
;; do for all files
(while file-list
(unless noninteractive
- (message "Scanning %s %s\"%s\"... (%2d%s)"
+ (message "Scanning %s %s\"%s\"... (%2d%%)"
(if is-directory "directory" "files")
(or num-string "") name
- (/ (* 100 (- no-files (length file-list))) no-files) "%"))
+ (floor (* 100.0 (- no-files (length file-list))) no-files)))
(let ((file-name (abbreviate-file-name (car file-list)))
ent-list arch-list arch-ent-list conf-list
pack-list pack-body-list inst-list inst-ent-list)
(while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 1))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(lib-alist (vhdl-scan-context-clause)))
(if (nth 1 ent-entry)
(vhdl-warning-when-idle
ent-name (nth 1 ent-entry) (nth 2 ent-entry)
file-name (vhdl-current-line))
(push ent-key ent-list)
- (aput 'ent-alist ent-key
- (list ent-name file-name (vhdl-current-line)
- (nth 3 ent-entry) (nth 4 ent-entry)
- lib-alist)))))
+ (vhdl-aput 'ent-alist ent-key
+ (list ent-name file-name (vhdl-current-line)
+ (nth 3 ent-entry) (nth 4 ent-entry)
+ lib-alist)))))
;; scan for architectures
(goto-char (point-min))
(while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(arch-key (downcase arch-name))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key))
(lib-arch-alist (vhdl-scan-context-clause)))
(if arch-entry
(vhdl-warning-when-idle
(nth 2 arch-entry) file-name (vhdl-current-line))
(setq arch-list (cons arch-key arch-list)
arch-ent-list (cons ent-key arch-ent-list))
- (aput 'arch-alist arch-key
- (list arch-name file-name (vhdl-current-line) nil
- lib-arch-alist))
- (aput 'ent-alist ent-key
- (list (or (nth 0 ent-entry) ent-name)
- (nth 1 ent-entry) (nth 2 ent-entry)
- (vhdl-sort-alist arch-alist)
- arch-key (nth 5 ent-entry))))))
+ (vhdl-aput 'arch-alist arch-key
+ (list arch-name file-name (vhdl-current-line)
+ nil lib-arch-alist))
+ (vhdl-aput 'ent-alist ent-key
+ (list (or (nth 0 ent-entry) ent-name)
+ (nth 1 ent-entry) (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ arch-key (nth 5 ent-entry))))))
;; scan for configurations
(goto-char (point-min))
(while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((conf-name (match-string-no-properties 1))
(conf-key (downcase conf-name))
- (conf-entry (aget conf-alist conf-key t))
+ (conf-entry (vhdl-aget conf-alist conf-key))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(lib-alist (vhdl-scan-context-clause))
inst-lib-key)
comp-conf-list))
(setq inst-key-list (cdr inst-key-list)))))
- (aput 'conf-alist conf-key
- (list conf-name file-name conf-line ent-key
- arch-key comp-conf-list lib-alist)))))
+ (vhdl-aput 'conf-alist conf-key
+ (list conf-name file-name conf-line ent-key
+ arch-key comp-conf-list lib-alist)))))
;; scan for packages
(goto-char (point-min))
(while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((pack-name (match-string-no-properties 2))
(pack-key (downcase pack-name))
(is-body (match-string-no-properties 1))
- (pack-entry (aget pack-alist pack-key t))
+ (pack-entry (vhdl-aget pack-alist pack-key))
(pack-line (vhdl-current-line))
(end-of-unit (vhdl-get-end-of-unit))
comp-name func-name comp-alist func-alist lib-alist)
(if is-body
(push pack-key pack-body-list)
(push pack-key pack-list))
- (aput
+ (vhdl-aput
'pack-alist pack-key
(if is-body
(list (or (nth 0 pack-entry) pack-name)
(ent-key (downcase ent-name))
(arch-name (match-string-no-properties 1))
(arch-key (downcase arch-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key))
(beg-of-unit (point))
(end-of-unit (vhdl-get-end-of-unit))
(inst-no 0)
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
"\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
(or (not limit-hier-inst-no)
- (<= (setq inst-no (1+ inst-no))
+ (<= (if (or (match-string 14)
+ (match-string 16))
+ inst-no
+ (setq inst-no (1+ inst-no)))
limit-hier-inst-no)))
(cond
;; block/generate beginning found
(setcar tmp-inst-alist inst-entry))
(setq tmp-inst-alist (cdr tmp-inst-alist)))))
;; save in cache
- (aput 'arch-alist arch-key
- (list (nth 0 arch-entry) (nth 1 arch-entry)
- (nth 2 arch-entry) inst-alist
- (nth 4 arch-entry)))
- (aput 'ent-alist ent-key
- (list (nth 0 ent-entry) (nth 1 ent-entry)
- (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
- (nth 4 ent-entry) (nth 5 ent-entry)))
+ (vhdl-aput 'arch-alist arch-key
+ (list (nth 0 arch-entry) (nth 1 arch-entry)
+ (nth 2 arch-entry) inst-alist
+ (nth 4 arch-entry)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 ent-entry) (nth 1 ent-entry)
+ (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ (nth 4 ent-entry) (nth 5 ent-entry)))
(when (and limit-hier-inst-no
(> inst-no limit-hier-inst-no))
(message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name)
(setq big-files t))
(goto-char end-of-unit))))
;; remember design units for this file
- (aput 'file-alist file-name
- (list ent-list arch-list arch-ent-list conf-list
- pack-list pack-body-list inst-list inst-ent-list))
+ (vhdl-aput 'file-alist file-name
+ (list ent-list arch-list arch-ent-list conf-list
+ pack-list pack-body-list
+ inst-list inst-ent-list))
(setq ent-inst-list (append inst-ent-list ent-inst-list))))))
(setq file-list (cdr file-list))))
(when (or (and (not project) files-exist)
;; check whether configuration has a corresponding entity/architecture
(setq tmp-list conf-alist)
(while tmp-list
- (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
- (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
+ (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list))))
+ (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)))
(setq tmp-entry (car tmp-list))
(vhdl-warning-when-idle
"Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
(add-to-list 'vhdl-updated-project-list (or project dir-name)))
;; clear directory alists
(unless project
- (adelete 'vhdl-entity-alist key)
- (adelete 'vhdl-config-alist key)
- (adelete 'vhdl-package-alist key)
- (adelete 'vhdl-ent-inst-alist key)
- (adelete 'vhdl-file-alist key))
+ (vhdl-adelete 'vhdl-entity-alist key)
+ (vhdl-adelete 'vhdl-config-alist key)
+ (vhdl-adelete 'vhdl-package-alist key)
+ (vhdl-adelete 'vhdl-ent-inst-alist key)
+ (vhdl-adelete 'vhdl-file-alist key))
;; put directory contents into cache
- (aput 'vhdl-entity-alist key ent-alist)
- (aput 'vhdl-config-alist key conf-alist)
- (aput 'vhdl-package-alist key pack-alist)
- (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
- (aput 'vhdl-file-alist key file-alist)
+ (vhdl-aput 'vhdl-entity-alist key ent-alist)
+ (vhdl-aput 'vhdl-config-alist key conf-alist)
+ (vhdl-aput 'vhdl-package-alist key pack-alist)
+ (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
+ (vhdl-aput 'vhdl-file-alist key file-alist)
;; final messages
(message "Scanning %s %s\"%s\"...done"
(if is-directory "directory" "files") (or num-string "") name)
(defun vhdl-scan-project-contents (project)
"Scan the contents of all VHDL files found in the directories and files
of PROJECT."
- (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
+ (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
(default-dir (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist project))))
+ (nth 1 (vhdl-aget vhdl-project-alist project))))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
dir-list-tmp dir dir-name num-dir act-dir recursive)
;; clear project alists
- (adelete 'vhdl-entity-alist project)
- (adelete 'vhdl-config-alist project)
- (adelete 'vhdl-package-alist project)
- (adelete 'vhdl-ent-inst-alist project)
- (adelete 'vhdl-file-alist project)
+ (vhdl-adelete 'vhdl-entity-alist project)
+ (vhdl-adelete 'vhdl-config-alist project)
+ (vhdl-adelete 'vhdl-package-alist project)
+ (vhdl-adelete 'vhdl-ent-inst-alist project)
+ (vhdl-adelete 'vhdl-file-alist project)
;; expand directory names by default-directory
(message "Collecting source files...")
(while dir-list
(add-to-list 'dir-list-tmp (file-name-directory dir-name))
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
- (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
+ (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
(message "Scanning project \"%s\"...done" project)))
(defun vhdl-update-file-contents (file-name)
(when (member dir-name (nth 1 (car directory-alist)))
(let* ((vhdl-project (nth 0 (car directory-alist)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
- (conf-alist (aget vhdl-config-alist (or project dir-name) t))
- (pack-alist (aget vhdl-package-alist (or project dir-name) t))
- (ent-inst-list (car (aget vhdl-ent-inst-alist
- (or project dir-name) t)))
- (file-alist (aget vhdl-file-alist (or project dir-name) t))
- (file-entry (aget file-alist file-name t))
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project dir-name)))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or project dir-name)))
+ (pack-alist (vhdl-aget vhdl-package-alist
+ (or project dir-name)))
+ (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
+ (or project dir-name))))
+ (file-alist (vhdl-aget vhdl-file-alist (or project dir-name)))
+ (file-entry (vhdl-aget file-alist file-name))
(ent-list (nth 0 file-entry))
(arch-list (nth 1 file-entry))
(arch-ent-list (nth 2 file-entry))
;; entities
(while ent-list
(setq key (car ent-list)
- entry (aget ent-alist key t))
+ entry (vhdl-aget ent-alist key))
(when (equal file-name (nth 1 entry))
(if (nth 3 entry)
- (aput 'ent-alist key
- (list (nth 0 entry) nil nil (nth 3 entry) nil))
- (adelete 'ent-alist key)))
+ (vhdl-aput 'ent-alist key
+ (list (nth 0 entry) nil nil (nth 3 entry) nil))
+ (vhdl-adelete 'ent-alist key)))
(setq ent-list (cdr ent-list)))
;; architectures
(while arch-list
(setq key (car arch-list)
ent-key (car arch-ent-list)
- entry (aget ent-alist ent-key t)
+ entry (vhdl-aget ent-alist ent-key)
arch-alist (nth 3 entry))
- (when (equal file-name (nth 1 (aget arch-alist key t)))
- (adelete 'arch-alist key)
+ (when (equal file-name (nth 1 (vhdl-aget arch-alist key)))
+ (vhdl-adelete 'arch-alist key)
(if (or (nth 1 entry) arch-alist)
- (aput 'ent-alist ent-key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- arch-alist (nth 4 entry) (nth 5 entry)))
- (adelete 'ent-alist ent-key)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ arch-alist (nth 4 entry) (nth 5 entry)))
+ (vhdl-adelete 'ent-alist ent-key)))
(setq arch-list (cdr arch-list)
arch-ent-list (cdr arch-ent-list)))
;; configurations
(while conf-list
(setq key (car conf-list))
- (when (equal file-name (nth 1 (aget conf-alist key t)))
- (adelete 'conf-alist key))
+ (when (equal file-name (nth 1 (vhdl-aget conf-alist key)))
+ (vhdl-adelete 'conf-alist key))
(setq conf-list (cdr conf-list)))
;; package declarations
(while pack-list
(setq key (car pack-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key))
(when (equal file-name (nth 1 entry))
(if (nth 6 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) nil nil nil nil nil
- (nth 6 entry) (nth 7 entry) (nth 8 entry)
- (nth 9 entry)))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) nil nil nil nil nil
+ (nth 6 entry) (nth 7 entry) (nth 8 entry)
+ (nth 9 entry)))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-list (cdr pack-list)))
;; package bodies
(while pack-body-list
(setq key (car pack-body-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key))
(when (equal file-name (nth 6 entry))
(if (nth 1 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- (nth 3 entry) (nth 4 entry) (nth 5 entry)
- nil nil nil nil))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ (nth 3 entry) (nth 4 entry) (nth 5 entry)
+ nil nil nil nil))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-body-list (cdr pack-body-list)))
;; instantiated entities
(while inst-ent-list
(vhdl-delete (car inst-ent-list) ent-inst-list))
(setq inst-ent-list (cdr inst-ent-list)))
;; update caches
- (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
- (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
- (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
- (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
+ (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
;; scan file
(vhdl-scan-directory-contents file-name project t)
(when (or (and vhdl-speedbar-show-projects project)
&optional include-top ent-hier)
"Get instantiation hierarchy beginning in architecture ARCH-KEY of
entity ENT-KEY."
- (let* ((ent-entry (aget ent-alist ent-key t))
- (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
+ (let* ((ent-entry (vhdl-aget ent-alist ent-key))
+ (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
(cdar (last (nth 3 ent-entry)))))
(inst-alist (nth 3 arch-entry))
inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
(setq level (1+ level)))
(when (member ent-key ent-hier)
(error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
- ;; check configured architecture (already checked during scanning)
-; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
-; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
;; process all instances
(while inst-alist
(setq inst-entry (car inst-alist)
(downcase (or inst-comp-name ""))))))
(setq tmp-list (cdr tmp-list)))
(setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
- (setq inst-conf-entry (aget conf-alist inst-conf-key t))
+ (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key))
(when (and inst-conf-key (not inst-conf-entry))
(vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
;; determine entity
(setq inst-ent-key
(or (nth 2 (car tmp-list)) ; from configuration
(nth 3 inst-conf-entry) ; from subconfiguration
- (nth 3 (aget conf-alist (nth 7 inst-entry) t))
+ (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry)))
; from configuration spec.
(nth 5 inst-entry))) ; from direct instantiation
- (setq inst-ent-entry (aget ent-alist inst-ent-key t))
+ (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key))
;; determine architecture
(setq inst-arch-key
(or (nth 3 (car tmp-list)) ; from configuration
(nth 4 inst-conf-entry) ; from subconfiguration
(nth 6 inst-entry) ; from direct instantiation
- (nth 4 (aget conf-alist (nth 7 inst-entry)))
+ (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
; from configuration spec.
(nth 4 inst-ent-entry) ; MRA
(caar (nth 3 inst-ent-entry)))) ; first alphabetically
- (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
+ (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key))
;; set library
(setq inst-lib-key
(or (nth 5 (car tmp-list)) ; from configuration
(defun vhdl-get-instantiations (ent-key indent)
"Get all instantiations of entity ENT-KEY."
- (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (vhdl-speedbar-line-key indent)))
arch-alist inst-alist ent-inst-list
ent-entry arch-entry inst-entry)
(while ent-alist
(insert ")\n")
(when (member 'hierarchy vhdl-speedbar-save-cache)
(insert "\n;; entity and architecture cache\n"
- "(aput 'vhdl-entity-alist " key " '")
- (print (aget vhdl-entity-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-entity-alist " key " '")
+ (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
(insert ")\n\n;; configuration cache\n"
- "(aput 'vhdl-config-alist " key " '")
- (print (aget vhdl-config-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-config-alist " key " '")
+ (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
(insert ")\n\n;; package cache\n"
- "(aput 'vhdl-package-alist " key " '")
- (print (aget vhdl-package-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-package-alist " key " '")
+ (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
(insert ")\n\n;; instantiated entities cache\n"
- "(aput 'vhdl-ent-inst-alist " key " '")
- (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-ent-inst-alist " key " '")
+ (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
(insert ")\n\n;; design units per file cache\n"
- "(aput 'vhdl-file-alist " key " '")
- (print (aget vhdl-file-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-file-alist " key " '")
+ (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
(when project
(insert ")\n\n;; source directories in project cache\n"
- "(aput 'vhdl-directory-alist " key " '")
- (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
+ "(vhdl-aput 'vhdl-directory-alist " key " '")
+ (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
(insert ")\n"))
(when (member 'display vhdl-speedbar-save-cache)
(insert "\n;; shown design units cache\n"
- "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
- (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
+ "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
+ (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
(current-buffer))
(insert ")\n"))
(setq vhdl-updated-project-list
(defun vhdl-speedbar-initialize ()
"Initialize speedbar."
;; general settings
-; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil)
;; VHDL file extensions (extracted from `auto-mode-alist')
(let ((mode-alist auto-mode-alist))
(while mode-alist
(append
'(("vhdl directory" vhdl-speedbar-update-current-unit)
("vhdl project" vhdl-speedbar-update-current-project
- vhdl-speedbar-update-current-unit)
-; ("files" (lambda () (setq speedbar-ignored-path-regexp
-; (speedbar-extension-list-to-regex
-; speedbar-ignored-path-expressions))))
- )
+ vhdl-speedbar-update-current-unit))
speedbar-stealthy-function-list))
(when (eq vhdl-speedbar-display-mode 'directory)
(setq speedbar-initial-expansion-list-name "vhdl directory"))
(concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
(goto-char (match-end 1))
(speedbar-do-function-pointer)))
- (setq project-alist (cdr project-alist))))
-; (vhdl-speedbar-update-current-project)
-; (vhdl-speedbar-update-current-unit nil t)
- )
+ (setq project-alist (cdr project-alist)))))
(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
"Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil,
(vhdl-scan-project-contents project))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist project t)
- (aget vhdl-config-alist project t)
- (aget vhdl-package-alist project t)
- (car (aget vhdl-ent-inst-alist project t)) indent)
+ (vhdl-aget vhdl-entity-alist project)
+ (vhdl-aget vhdl-config-alist project)
+ (vhdl-aget vhdl-package-alist project)
+ (car (vhdl-aget vhdl-ent-inst-alist project)) indent)
(insert (int-to-string indent) ":\n")
(put-text-property (- (point) 3) (1- (point)) 'invisible t)
(put-text-property (1- (point)) (point) 'invisible nil)
(vhdl-scan-directory-contents directory))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist directory t)
- (aget vhdl-config-alist directory t)
- (aget vhdl-package-alist directory t)
- (car (aget vhdl-ent-inst-alist directory t)) depth)
+ (vhdl-aget vhdl-entity-alist directory)
+ (vhdl-aget vhdl-config-alist directory)
+ (vhdl-aget vhdl-package-alist directory)
+ (car (vhdl-aget vhdl-ent-inst-alist directory)) depth)
;; expand design units
(vhdl-speedbar-expand-units directory)
- (aput 'vhdl-directory-alist directory (list (list directory))))
+ (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
ent-inst-list depth)
(defun vhdl-speedbar-expand-units (key)
"Expand design units in directory/project KEY according to
`vhdl-speedbar-shown-unit-alist'."
- (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
+ (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
(vhdl-speedbar-update-current-unit nil)
vhdl-updated-project-list)
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-prepare-search-1
(while unit-alist ; expand units
(vhdl-speedbar-goto-this-unit key (caar unit-alist))
(progn (setq vhdl-speedbar-shown-project-list nil)
(vhdl-speedbar-refresh))
(let ((key (vhdl-speedbar-line-key)))
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key)))))
"Expand all design units in current directory/project."
(interactive)
(let* ((key (vhdl-speedbar-line-key))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
- (pack-alist (aget vhdl-package-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
+ (pack-alist (vhdl-aget vhdl-package-alist key))
arch-alist unit-alist subunit-alist)
(add-to-list 'vhdl-speedbar-shown-project-list key)
(while ent-alist
(while pack-alist
(push (list (caar pack-alist)) unit-alist)
(setq pack-alist (cdr pack-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(vhdl-speedbar-refresh)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
(cond
((string-match "+" text) ; expand entity
(let* ((key (vhdl-speedbar-line-key indent))
- (ent-alist (aget vhdl-entity-alist key t))
- (ent-entry (aget ent-alist token t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (ent-entry (vhdl-aget ent-alist token))
(arch-alist (nth 3 ent-entry))
(inst-alist (vhdl-get-instantiations token indent))
(subpack-alist (nth 5 ent-entry))
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add entity to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-change-expand-button-char ?+)
;; remove entity from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
(cond
((string-match "+" text) ; expand architecture
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (car token) (cdr token) nil nil
0 (1- indent)))
- (ent-entry (aget ent-alist (car token) t))
- (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
+ (ent-entry (vhdl-aget ent-alist (car token)))
+ (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token)))
(subpack-alist (nth 4 arch-entry))
entry)
(if (not (or hier-alist subpack-alist))
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add architecture to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
+ (vhdl-aput 'unit-alist (car token)
+ (list (cons (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-change-expand-button-char ?+)
;; remove architecture from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
+ (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
(cond
((string-match "+" text) ; expand configuration
(let* ((key (vhdl-speedbar-line-key indent))
- (conf-alist (aget vhdl-config-alist key t))
- (conf-entry (aget conf-alist token))
- (ent-alist (aget vhdl-entity-alist key t))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
+ (conf-entry (vhdl-aget conf-alist token))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (nth 3 conf-entry)
(nth 4 conf-entry) token (nth 5 conf-entry)
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add configuration to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-change-expand-button-char ?+)
;; remove configuration from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
(cond
((string-match "+" text) ; expand package
(let* ((key (vhdl-speedbar-line-key indent))
- (pack-alist (aget vhdl-package-alist key t))
- (pack-entry (aget pack-alist token t))
+ (pack-alist (vhdl-aget vhdl-package-alist key))
+ (pack-entry (vhdl-aget pack-alist token))
(comp-alist (nth 3 pack-entry))
(func-alist (nth 4 pack-entry))
(func-body-alist (nth 8 pack-entry))
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add package to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
(while func-alist
(setq func-entry (car func-alist)
- func-body-entry (aget func-body-alist (car func-entry) t))
+ func-body-entry (vhdl-aget func-body-alist
+ (car func-entry)))
(when (nth 2 func-entry)
(vhdl-speedbar-make-subprogram-line
(nth 1 func-entry)
(speedbar-change-expand-button-char ?+)
;; remove package from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
"Insert required packages."
- (let* ((pack-alist (aget vhdl-package-alist
- (vhdl-speedbar-line-key dir-indent) t))
+ (let* ((pack-alist (vhdl-aget vhdl-package-alist
+ (vhdl-speedbar-line-key dir-indent)))
pack-key lib-name pack-entry)
(when subpack-alist
(vhdl-speedbar-make-title-line "Packages Used:" indent))
(while subpack-alist
(setq pack-key (cdar subpack-alist)
lib-name (caar subpack-alist))
- (setq pack-entry (aget pack-alist pack-key t))
+ (setq pack-entry (vhdl-aget pack-alist pack-key))
(vhdl-speedbar-make-subpack-line
(or (nth 0 pack-entry) pack-key) lib-name
(cons (nth 1 pack-entry) (nth 2 pack-entry))
(or always (not (equal file-name speedbar-last-selected-file))))
(if vhdl-speedbar-show-projects
(while project-list
- (setq file-alist (append file-alist (aget vhdl-file-alist
- (car project-list) t)))
+ (setq file-alist (append file-alist
+ (vhdl-aget vhdl-file-alist
+ (car project-list))))
(setq project-list (cdr project-list)))
- (setq file-alist (aget vhdl-file-alist
- (abbreviate-file-name default-directory) t)))
+ (setq file-alist
+ (vhdl-aget vhdl-file-alist
+ (abbreviate-file-name default-directory))))
(select-frame speedbar-frame)
(set-buffer speedbar-buffer)
(speedbar-with-writable
(vhdl-prepare-search-1
(save-excursion
;; unhighlight last units
- (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
+ (let* ((file-entry (vhdl-aget file-alist
+ speedbar-last-selected-file)))
(vhdl-speedbar-update-units
- "\\[.\\] " (nth 0 file-entry)
+ "\\[.] " (nth 0 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-entity-face)
(vhdl-speedbar-update-units
"{.} " (nth 1 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
(vhdl-speedbar-update-units
- "\\[.\\] " (nth 3 file-entry)
+ "\\[.] " (nth 3 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
(vhdl-speedbar-update-units
"[]>] " (nth 4 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-package-face)
(vhdl-speedbar-update-units
- "\\[.\\].+(" '("body")
+ "\\[.].+(" '("body")
speedbar-last-selected-file 'vhdl-speedbar-package-face)
(vhdl-speedbar-update-units
"> " (nth 6 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
;; highlight current units
- (let* ((file-entry (aget file-alist file-name t)))
+ (let* ((file-entry (vhdl-aget file-alist file-name)))
(setq
pos (vhdl-speedbar-update-units
- "\\[.\\] " (nth 0 file-entry)
+ "\\[.] " (nth 0 file-entry)
file-name 'vhdl-speedbar-entity-selected-face pos)
pos (vhdl-speedbar-update-units
"{.} " (nth 1 file-entry)
file-name 'vhdl-speedbar-architecture-selected-face pos)
pos (vhdl-speedbar-update-units
- "\\[.\\] " (nth 3 file-entry)
+ "\\[.] " (nth 3 file-entry)
file-name 'vhdl-speedbar-configuration-selected-face pos)
pos (vhdl-speedbar-update-units
"[]>] " (nth 4 file-entry)
file-name 'vhdl-speedbar-package-selected-face pos)
pos (vhdl-speedbar-update-units
- "\\[.\\].+(" '("body")
+ "\\[.].+(" '("body")
file-name 'vhdl-speedbar-package-selected-face pos)
pos (vhdl-speedbar-update-units
"> " (nth 6 file-entry)
(let ((buffer (get-file-buffer (car token))))
(speedbar-find-file-in-frame (car token))
(when (or vhdl-speedbar-jump-to-unit buffer)
- (vhdl-goto-line (cdr token))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(recenter))
(vhdl-speedbar-update-current-unit t t)
(speedbar-set-timer dframe-update-speed)
(if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
(error "ERROR: No entity/component or subprogram under cursor")
(beginning-of-line)
- (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
+ (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
(condition-case info
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (vhdl-goto-line (cdr token))
+ (progn (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(end-of-line)
(if is-entity
(vhdl-port-copy)
(error "ERROR: No architecture under cursor")
(let* ((arch-key (downcase (vhdl-speedbar-line-text)))
(ent-key (downcase (vhdl-speedbar-higher-text)))
- (ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (ent-entry (aget ent-alist ent-key t)))
+ (ent-alist (vhdl-aget
+ vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
+ (ent-entry (vhdl-aget ent-alist ent-key)))
(setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
(speedbar-refresh))))
;; add speedbar
(when (fboundp 'speedbar)
- (condition-case ()
- (when (and vhdl-speedbar-auto-open
- (not (and (boundp 'speedbar-frame)
- (frame-live-p speedbar-frame))))
- (speedbar-frame-mode 1)
- (if (fboundp 'speedbar-select-attached-frame)
- (speedbar-select-attached-frame)
- (select-frame speedbar-attached-frame)))
- (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))))
+ (let ((current-frame (selected-frame)))
+ (condition-case ()
+ (when (and vhdl-speedbar-auto-open
+ (not (and (boundp 'speedbar-frame)
+ (frame-live-p speedbar-frame))))
+ (speedbar-frame-mode 1))
+ (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))
+ (select-frame current-frame)))
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
(setq constant-entry
(cons constant-name
(if (match-string 1)
- (or (aget generic-alist (match-string 2) t)
+ (or (vhdl-aget generic-alist (match-string 2))
(error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
(push constant-entry constant-alist)
(vhdl-forward-syntactic-ws)
(while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
- (setq signal-entry (cons signal-name
- (if (match-string 1)
- (or (aget port-alist (match-string 2) t)
- (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
- (cdar port-alist))))
+ (setq signal-entry
+ (cons signal-name
+ (if (match-string 1)
+ (or (vhdl-aget port-alist (match-string 2))
+ (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
+ (cdar port-alist))))
(push signal-entry signal-alist)
(setq signal-name (downcase signal-name))
(if (equal (upcase (nth 2 signal-entry)) "IN")
(pack-file-name
(concat (vhdl-replace-string vhdl-package-file-name pack-name t)
"." (file-name-extension (buffer-file-name))))
- (ent-alist (aget vhdl-entity-alist
- (or project default-directory) t))
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project
+ (abbreviate-file-name default-directory))))
(lazy-lock-minimum-size 0)
clause-pos component-pos)
(message "Generating components package \"%s\"..." pack-name)
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (vhdl-goto-line (nth 3 (car ent-alist)))
+ (progn (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
(end-of-line)
(vhdl-port-copy)))
(goto-char component-pos)
(when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
(setq conf-key (nth 0 (car tmp-alist))))
(setq tmp-alist (cdr tmp-alist)))
- (setq conf-entry (aget conf-alist conf-key t))
+ (setq conf-entry (vhdl-aget conf-alist conf-key))
;; insert binding indication ...
;; ... with subconfiguration (if exists)
(if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
(insert (vhdl-work-library) "." (nth 0 conf-entry))
(insert ";\n"))
;; ... with entity (if exists)
- (setq ent-entry (aget ent-alist (nth 5 inst-entry) t))
+ (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry)))
(when ent-entry
(indent-to (+ margin vhdl-basic-offset))
(vhdl-insert-keyword "USE ENTITY ")
(setq arch-name
;; choose architecture name a) from configuration,
;; b) from mra, or c) from first architecture
- (or (nth 0 (aget (nth 3 ent-entry)
- (or (nth 6 inst-entry)
- (nth 4 ent-entry)) t))
+ (or (nth 0 (vhdl-aget (nth 3 ent-entry)
+ (or (nth 6 inst-entry)
+ (nth 4 ent-entry))))
(nth 1 (car (nth 3 ent-entry)))))
(insert "(" arch-name ")"))
(insert ";\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-compose-configuration-architecture
(nth 0 ent-entry) arch-name ent-alist conf-alist
- (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
+ (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name)))))))
;; insert component configuration end
(indent-to margin)
(vhdl-insert-keyword "END FOR;\n")
"Generate configuration declaration."
(interactive)
(vhdl-require-hierarchy-info)
- (let ((ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (conf-alist (aget vhdl-config-alist
- (or (vhdl-project-p) default-directory) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
(from-speedbar ent-name)
inst-alist conf-name conf-file-name pos)
(vhdl-prepare-search-2
vhdl-compose-configuration-name
(concat ent-name " " arch-name)))
(setq inst-alist
- (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t))
- (downcase arch-name) t))))
+ (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name)))
+ (downcase arch-name)))))
(message "Generating configuration \"%s\"..." conf-name)
(if vhdl-compose-configuration-create-file
;; open configuration file
(defun vhdl-makefile-name ()
"Return the Makefile name of the current project or the current compiler if
no project is defined."
- (let ((project-alist (aget vhdl-project-alist vhdl-project))
- (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
+ (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)"
(or (nth 8 project-alist) (nth 8 compiler-alist)))
(defun vhdl-compile-directory ()
"Return the directory where compilation/make should be run."
- (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(directory (vhdl-resolve-env-variable
(if project
(vhdl-replace-string
(defun vhdl-compile-init ()
"Initialize for compilation."
- (when (or (null compilation-error-regexp-alist)
- (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
- compilation-error-regexp-alist)))
+ (when (and (not vhdl-emacs-22)
+ (or (null compilation-error-regexp-alist)
+ (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
+ compilation-error-regexp-alist))))
;; `compilation-error-regexp-alist'
(let ((commands-alist vhdl-compiler-alist)
regexp-alist sublist)
&optional file-options-only)
"Get compiler options. Returning nil means do not compile this file."
(let* ((compiler-options (nth 1 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 0 project-entry))
(exception-list (and file-name (nth 2 project-entry)))
(work-library (vhdl-work-library))
(defun vhdl-get-make-options (project compiler)
"Get make options."
(let* ((compiler-options (nth 3 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 1 project-entry))
(makefile-name (vhdl-makefile-name)))
;; insert Makefile name in compiler-specific options
`vhdl-compiler'."
(interactive)
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 0 compiler))
(default-directory (vhdl-compile-directory))
(or target (read-from-minibuffer "Target: " vhdl-make-target
vhdl-minibuffer-local-map)))
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 2 compiler))
(options (vhdl-get-make-options project compiler))
(let ((compiler-alist vhdl-compiler-alist)
(error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
(while compiler-alist
- ;; add error message regexps
- (setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
- (nth 11 (car compiler-alist)))
- error-regexp-alist))
- ;; add filename regexps
- (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ ;; only add regexps for currently selected compiler
+ (when (or (not vhdl-compile-use-local-error-regexp)
+ (equal vhdl-compiler (nth 0 (car compiler-alist))))
+ ;; add error message regexps
(setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
- (nth 12 (car compiler-alist)))
- error-regexp-alist)))
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
+ (nth 11 (car compiler-alist)))
+ error-regexp-alist))
+ ;; add filename regexps
+ (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ (setq error-regexp-alist
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
+ (nth 12 (car compiler-alist)))
+ error-regexp-alist))))
(setq compiler-alist (cdr compiler-alist)))
error-regexp-alist)
"List of regexps for VHDL compilers. For Emacs 22+.")
(interactive)
(when (and (boundp 'compilation-error-regexp-alist-alist)
(not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
+ ;; remove all other compilers
+ (when vhdl-compile-use-local-error-regexp
+ (setq compilation-error-regexp-alist nil))
+ ;; add VHDL compilers
(mapcar
(lambda (item)
(push (car item) compilation-error-regexp-alist)
(defun vhdl-generate-makefile ()
"Generate `Makefile'."
(interactive)
- (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 4 compiler)))
;; generate makefile
(vhdl-scan-directory-contents directory))))
(let* ((directory (abbreviate-file-name (vhdl-default-directory)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project directory) t))
- (conf-alist (aget vhdl-config-alist (or project directory) t))
- (pack-alist (aget vhdl-package-alist (or project directory) t))
- (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
- (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
- (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
- (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
- (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
- (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
+ (ent-alist (vhdl-aget vhdl-entity-alist (or project directory)))
+ (conf-alist (vhdl-aget vhdl-config-alist (or project directory)))
+ (pack-alist (vhdl-aget vhdl-package-alist (or project directory)))
+ (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
+ '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
+ "\\1.vhd" "\\1_body.vhd" identity)))
+ (mapping-exist
+ (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
+ (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
+ (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
+ (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
+ (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
+ (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
(adjust-case (nth 5 regexp-list))
(work-library (downcase (vhdl-work-library)))
(compile-directory (expand-file-name (vhdl-compile-directory)
;; check prerequisites
(unless (file-exists-p compile-directory)
(make-directory compile-directory t))
- (unless regexp-list
- (error "Please contact the VHDL Mode maintainer for support of \"%s\""
- vhdl-compiler))
+ (unless mapping-exist
+ (vhdl-warning
+ (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\""
+ vhdl-compiler vhdl-compiler) t))
(message "Generating makefile \"%s\"..." makefile-name)
;; rules for all entities
(setq tmp-list ent-alist)
compile-directory))
arch-alist (nth 4 ent-entry)
lib-alist (nth 6 ent-entry)
- rule (aget rule-alist ent-file-name)
+ rule (vhdl-aget rule-alist ent-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
second-list nil
subcomp-list nil)
(setq tmp-key (vhdl-replace-string
- ent-regexp (funcall adjust-case ent-key)))
+ ent-regexp
+ (funcall adjust-case
+ (concat ent-key " " work-library))))
(push (cons ent-key tmp-key) unit-list)
;; rule target for this entity
(push ent-key target-list)
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist ent-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
;; rules for all corresponding architectures
(while arch-alist
(setq arch-entry (car arch-alist)
compile-directory))
inst-alist (nth 4 arch-entry)
lib-alist (nth 5 arch-entry)
- rule (aget rule-alist arch-file-name)
+ rule (vhdl-aget rule-alist arch-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
arch-regexp
- (funcall adjust-case (concat arch-key " " ent-key))))
+ (funcall adjust-case
+ (concat arch-key " " ent-key " "
+ work-library))))
(setq unit-list
(cons (cons ent-arch-key tmp-key) unit-list))
(push ent-arch-key second-list)
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist arch-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
(setq arch-alist (cdr arch-alist)))
(push (list ent-key second-list (append subcomp-list all-pack-list))
prim-list))
arch-key (nth 5 conf-entry)
inst-alist (nth 6 conf-entry)
lib-alist (nth 7 conf-entry)
- rule (aget rule-alist conf-file-name)
+ rule (vhdl-aget rule-alist conf-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
subcomp-list (list ent-key))
(setq tmp-key (vhdl-replace-string
- conf-regexp (funcall adjust-case conf-key)))
+ conf-regexp
+ (funcall adjust-case
+ (concat conf-key " " work-library))))
(push (cons conf-key tmp-key) unit-list)
;; rule target for this configuration
(push conf-key target-list)
(while inst-alist
(setq inst-entry (car inst-alist))
(setq inst-ent-key (nth 2 inst-entry)
-; comp-arch-key (nth 2 inst-entry))
inst-conf-key (nth 4 inst-entry))
(when (equal (downcase (nth 5 inst-entry)) work-library)
(when inst-ent-key
(setq depend-list (cons inst-ent-key depend-list)
subcomp-list (cons inst-ent-key subcomp-list)))
-; (when comp-arch-key
-; (push (concat comp-ent-key "-" comp-arch-key) depend-list))
(when inst-conf-key
(setq depend-list (cons inst-conf-key depend-list)
subcomp-list (cons inst-conf-key subcomp-list))))
(setq inst-alist (cdr inst-alist)))
;; add rule
- (aput 'rule-alist conf-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
(push (list conf-key nil (append subcomp-list pack-list)) prim-list)
(setq conf-alist (cdr conf-alist)))
(setq conf-alist tmp-list)
(file-relative-name (nth 2 pack-entry)
compile-directory))
lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
- rule (aget rule-alist pack-file-name)
+ rule (vhdl-aget rule-alist pack-file-name)
target-list (nth 0 rule) depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-regexp (funcall adjust-case pack-key)))
+ pack-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(push (cons pack-key tmp-key) unit-list)
;; rule target for this package
(push pack-key target-list)
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist pack-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
;; rules for this package's body
(when (nth 7 pack-entry)
(setq pack-body-key (concat pack-key "-body")
(nth 7 pack-entry)
(file-relative-name (nth 7 pack-entry)
compile-directory))
- rule (aget rule-alist pack-body-file-name)
+ rule (vhdl-aget rule-alist pack-body-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-body-regexp (funcall adjust-case pack-key)))
+ pack-body-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(setq unit-list
(cons (cons pack-body-key tmp-key) unit-list))
;; rule target for this package's body
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist pack-body-file-name
- (list target-list depend-list)))
+ (vhdl-aput 'rule-alist pack-body-file-name
+ (list target-list depend-list)))
(setq prim-list
(cons (list pack-key (when pack-body-key (list pack-body-key))
all-pack-list)
(setq pack-alist (cdr pack-alist)))
(setq pack-alist tmp-list)
;; generate Makefile
- (let* ((project (aget vhdl-project-alist project))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist project))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(compiler-id (nth 9 compiler))
(library-directory
(vhdl-resolve-env-variable
compile-directory))))
(insert "\n\n# Define library paths\n"
"\nLIBRARY-" work-library " = " library-directory "\n")
+ (unless mapping-exist
+ (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
+ ")/make" "\n"))
;; insert variable definitions for all library unit files
(insert "\n\n# Define library unit files\n")
(setq tmp-list unit-list)
(while unit-list
(insert "\nUNIT-" work-library "-" (caar unit-list)
- " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
+ " = \\\n\t$(LIBRARY-" work-library
+ (if mapping-exist "" "-make") ")/" (cdar unit-list))
(setq unit-list (cdr unit-list)))
;; insert variable definition for list of all library unit files
(insert "\n\n\n# Define list of all library unit files\n"
;; insert `make library' rule
(insert "\n\n# Rule for creating library directory\n"
"\n" (nth 2 vhdl-makefile-default-targets) " :"
- " \\\n\t\t$(LIBRARY-" work-library ")\n"
+ " \\\n\t\t$(LIBRARY-" work-library ")"
+ (if mapping-exist ""
+ (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
+ "\n"
"\n$(LIBRARY-" work-library ") :"
"\n\t"
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
(concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
"\n")
+ (unless mapping-exist
+ (insert "\n$(LIBRARY-" work-library "-make) :"
+ "\n\t"
+ "mkdir -p $(LIBRARY-" work-library "-make)\n"))
;; insert '.PHONY' declaration
(insert "\n\n.PHONY : "
(nth 0 vhdl-makefile-default-targets) " "
(setq subcomp-list
(sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
(setq unit-key (caar prim-list)
- unit-name (or (nth 0 (aget ent-alist unit-key t))
- (nth 0 (aget conf-alist unit-key t))
- (nth 0 (aget pack-alist unit-key t))))
+ unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
+ (nth 0 (vhdl-aget conf-alist unit-key))
+ (nth 0 (vhdl-aget pack-alist unit-key))))
(insert "\n" unit-key)
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
(nth 0 rule)
(if (equal vhdl-compile-post-command "") ""
" $(POST-COMPILE)") "\n")
+ (insert "\n"))
+ (unless (and options mapping-exist)
(setq tmp-list target-list)
(while target-list
- (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
- (if (cdr target-list) " \\" "\n"))
+ (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
(setq target-list (cdr target-list)))
(setq target-list tmp-list))
(setq rule-alist (cdr rule-alist)))
+
(insert "\n\n### " makefile-name " ends here\n")
;; run Makefile generation hook
(run-hooks 'vhdl-makefile-generation-hook)
(progn (save-buffer)
(kill-buffer (current-buffer))
(set-buffer orig-buffer)
- (add-to-history 'file-name-history makefile-path-name))
+ (when (fboundp 'add-to-history)
+ (add-to-history 'file-name-history makefile-path-name)))
(vhdl-warning-when-idle
(format "File not writable: \"%s\""
(abbreviate-file-name makefile-path-name)))
'vhdl-argument-list-indent
'vhdl-association-list-with-formals
'vhdl-conditions-in-parenthesis
+ 'vhdl-sensitivity-list-all
'vhdl-zero-string
'vhdl-one-string
'vhdl-file-header
(defconst vhdl-doc-release-notes nil
"\
+Release Notes for VHDL Mode 3.37
+================================
+
+- Added support for VHDL'08:
+ - New keywords, types, functions, attributes, operators, packages
+ - Context declaration
+ - Block comments
+ - Directives
+ - `all' keyword in sensitivity list
+
+
Release Notes for VHDL Mode 3.34
================================
Reserved words in VHDL
----------------------
+VHDL'08 (IEEE Std 1076-2008):
+ `vhdl-08-keywords' : keywords
+ `vhdl-08-types' : standardized types
+ `vhdl-08-attributes' : standardized attributes
+ `vhdl-08-functions' : standardized functions
+ `vhdl-08-packages' : standardized packages and libraries
+
VHDL'93/02 (IEEE Std 1076-1993/2002):
`vhdl-02-keywords' : keywords
`vhdl-02-types' : standardized types
For VHDL coding style and naming convention guidelines, see the following
references:
-\[1] Ben Cohen.
+[1] Ben Cohen.
\"VHDL Coding Styles and Methodologies\".
Kluwer Academic Publishers, 1999.
http://members.aol.com/vhdlcohen/vhdl/
-\[2] Michael Keating and Pierre Bricaud.
+[2] Michael Keating and Pierre Bricaud.
\"Reuse Methodology Manual, Second Edition\".
Kluwer Academic Publishers, 1999.
http://www.openmore.com/openmore/rmm2.html
-\[3] European Space Agency.
+[3] European Space Agency.
\"VHDL Modelling Guidelines\".
ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}