;;; vhdl-mode.el --- major mode for editing VHDL code
-;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2014 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.33.28"
+(defconst vhdl-version "3.35.2"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2010-09-22"
+(defconst vhdl-time-stamp "2014-03-28"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X
-;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally)
+;; 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
;; following line in your Emacs start-up file `.emacs':
-;; (setq load-path (cons (expand-file-name "<directory-name>") load-path))
+;; (push (expand-file-name "<directory-name>") load-path)
;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
;; directory. Otherwise, byte-compile the source file:
;; (not required in Emacs 20 and higher):
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
-;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
+;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
;; More detailed installation instructions are included in the official
;; VHDL Mode distribution.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Acknowledgements
+;; Acknowledgments
;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
;; and Steve Grout.
;; Emacs 21+ handling
(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 21, 22, ... is used.")
+;; Emacs 22+ handling
(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 22, ... is used.")
(defcustom vhdl-compiler-alist
'(
+ ;; 60: docal <= false;
+ ;; ^^^^^
+ ;; [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]+\\):" 0 1 0) ("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_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30
- ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1"
+ ;; 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"
- (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 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]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 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+ (\\(.+\\),\\([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" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
- ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([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)
+ 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]+\\):" 0 1 2)
+ ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
nil)
;; ModelSim, Model Technology: vcom test.vhd
;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
- ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 0)
+ ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 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 0) ("" 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
+ ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used
+ ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text
+ ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal
+ ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library
+ ;; 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)
+ 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\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 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 0) ("" 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+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 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 \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 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]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 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]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 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]:\"\\(.+\\)\":\\([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]+\\) \\*\\*\\*" 0 1 0)
+ ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
;; VeriBest: vc vhdl test.vhd
;; [Error] Name BITA is unknown
("VeriBest" "vc" "vhdl" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
- ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0)
+ ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0)
nil)
;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
;; Compiling "test.vhd" line 1...
;; **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]+\\) \\*\\*\\*" 0 1 0)
+ ("\\*\\*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]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0)
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0)
nil)
)
"List of available VHDL compilers and their properties.
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
(string :tag "ID string ")
(list :tag "Error message" :indent 4
(regexp :tag "Regexp ")
- (integer :tag "File subexp index")
+ (choice :tag "File subexp "
+ (integer :tag "Index")
+ (const :tag "No file name" nil))
(integer :tag "Line subexp index")
- (integer :tag "Column subexp idx"))
+ (choice :tag "Column subexp "
+ (integer :tag "Index")
+ (const :tag "No column number" nil)))
(list :tag "File message" :indent 4
(regexp :tag "Regexp ")
(integer :tag "File subexp index"))
(const :tag "Downcase" downcase))))))
:set (lambda (variable value)
(vhdl-custom-set variable value 'vhdl-update-mode-menu))
+ :version "24.4"
:group 'vhdl-compile)
(defcustom vhdl-compiler "GHDL"
Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
:type (let ((alist vhdl-compiler-alist) list)
(while alist
- (setq list (cons (list 'const (caar alist)) list))
+ (push (list 'const (caar alist)) list)
(setq alist (cdr alist)))
(append '(choice) (nreverse list)))
:group 'vhdl-compile)
:type '(list (string :tag "Compile entire design")
(string :tag "Clean entire design ")
(string :tag "Create design library"))
+ :version "24.3"
:group 'vhdl-compile)
(defcustom vhdl-makefile-generation-hook nil
(list :tag "Compiler" :indent 6
,(let ((alist vhdl-compiler-alist) list)
(while alist
- (setq list (cons (list 'const (caar alist)) list))
+ (push (list 'const (caar alist)) list)
(setq alist (cdr alist)))
(append '(choice :tag "Compiler name")
(nreverse list)))
browser. The current project can also be changed temporarily in the menu."
:type (let ((alist vhdl-project-alist) list)
(while alist
- (setq list (cons (list 'const (caar alist)) list))
+ (push (list 'const (caar alist)) list)
(setq alist (cdr alist)))
(append '(choice (const :tag "None" nil) (const :tag "--"))
(nreverse list)))
the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
:type 'boolean
+ :version "24.3"
:group 'vhdl-style)
(defgroup vhdl-naming nil
"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)
(const :tag "Always" always))
:group 'vhdl-port)
+(defcustom vhdl-actual-generic-name '(".*" . "\\&")
+ (concat
+ "Specifies how actual generic names are obtained from formal generic names.
+In a component instantiation, an actual generic name can be
+obtained by modifying the formal generic name (e.g. attaching or stripping
+off a substring)."
+ vhdl-name-doc-string)
+ :type '(cons (regexp :tag "From regexp")
+ (string :tag "To string "))
+ :group 'vhdl-port
+ :version "24.4")
+
(defcustom vhdl-actual-port-name '(".*" . "\\&")
(concat
"Specifies how actual port names are obtained from formal port names.
(defvar end-comment-column)
-(defgroup vhdl-align nil
- "Customizations for alignment."
+(defgroup vhdl-beautify nil
+ "Customizations for beautification."
:group 'vhdl)
(defcustom vhdl-auto-align t
"Non-nil means align some templates automatically after generation."
:type 'boolean
- :group 'vhdl-align)
+ :group 'vhdl-beautify)
(defcustom vhdl-align-groups t
"Non-nil means align groups of code lines separately.
A group of code lines is a region of consecutive lines between two lines that
match the regexp in option `vhdl-align-group-separate'."
:type 'boolean
- :group 'vhdl-align)
+ :group 'vhdl-beautify)
(defcustom vhdl-align-group-separate "^\\s-*$"
"Regexp for matching a line that separates groups of lines for alignment.
\"^\\s-*$\": matches an empty line
\"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
:type 'regexp
- :group 'vhdl-align)
+ :group 'vhdl-beautify)
(defcustom vhdl-align-same-indent t
"Non-nil means align blocks with same indent separately.
lists). This gives nicer alignment in most cases.
Option `vhdl-align-groups' still applies within these blocks."
:type 'boolean
- :group 'vhdl-align)
+ :group 'vhdl-beautify)
+
+(defcustom vhdl-beautify-options '(t t t t t)
+ "List of options for beautifying code. Allows to disable individual
+features of code beautification."
+ :type '(list (boolean :tag "Whitespace cleanup ")
+ (boolean :tag "Single statement per line")
+ (boolean :tag "Indentation ")
+ (boolean :tag "Alignment ")
+ (boolean :tag "Case fixing "))
+ :group 'vhdl-beautify
+ :version "24.4")
(defgroup vhdl-highlight nil
:group 'vhdl-misc)
(defcustom vhdl-indent-comment-like-next-code-line t
- "*Non-nil means comment lines are indented like the following code line.
+ "Non-nil means comment lines are indented like the following code line.
Otherwise, comment lines are indented like the preceding code line.
Indenting comment lines like the following code line gives nicer indentation
when comments precede the code that they refer to."
:type 'boolean
+ :version "24.3"
:group 'vhdl-misc)
(defcustom vhdl-word-completion-case-sensitive nil
"Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
-are treated as single words otherwise.
-
-NOTE: Activate the new setting in a VHDL buffer by using the menu entry
- \"Activate Options\"."
+are treated as single words otherwise."
:type 'boolean
- :set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init))
:group 'vhdl-misc)
+(make-obsolete-variable 'vhdl-underscore-is-part-of-word
+ 'superword-mode "24.4")
(defgroup vhdl-related nil
(lambda (var)
(cons var (symbol-value var))))
varlist))))
- (setq vhdl-style-alist (cons default vhdl-style-alist))))
+ (push default vhdl-style-alist)))
(defvar vhdl-mode-hook nil
"Hook called by `vhdl-mode'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mandatory
-(require 'assoc)
(require 'compile) ; XEmacs
(require 'easymenu)
(require 'hippie-exp)
;; optional (minimize warning messages during compile)
+(unless (featurep 'xemacs)
(eval-when-compile
(require 'font-lock)
(require 'ps-print)
- (require 'speedbar))
+ (require 'speedbar))) ; for speedbar-with-writable
+
+;; functions from obsolete assoc.el package (obsoleted in GNU Emacs 24.3)
+(defun vhdl-asort (alist-symbol key)
+ "Move a specified key-value pair to the head of an alist.
+The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
+head is one matching KEY. Returns the sorted list and doesn't affect
+the order of any other key-value pair. Side effect sets alist to new
+sorted list."
+ (set alist-symbol
+ (sort (copy-alist (symbol-value alist-symbol))
+ (lambda (a _b) (equal (car a) key)))))
+
+(defun vhdl-anot-head-p (alist key)
+ "Find out if a specified key-value pair is not at the head of an alist.
+The alist to check is specified by ALIST and the key-value pair is the
+one matching the supplied KEY. Returns nil if ALIST is nil, or if
+key-value pair is at the head of the alist. Returns t if key-value
+pair is not at the head of alist. ALIST is not altered."
+ (not (equal (car (car alist)) key)))
+
+(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 optionally, VALUE. Returns the altered alist.
+
+If the key-value pair referenced by KEY can be found in the alist, and
+VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
+If VALUE is not supplied, or is nil, the key-value pair will not be
+modified, but will be moved to the head of the alist. If the key-value
+pair cannot be found in the alist, it will be inserted into the head
+of the alist (with value nil if VALUE is nil or not supplied)."
+ (let ((elem (list (cons key value)))
+ alist)
+ (vhdl-asort alist-symbol key)
+ (setq alist (symbol-value alist-symbol))
+ (cond ((null alist) (set alist-symbol elem))
+ ((vhdl-anot-head-p alist key) (set alist-symbol (nconc elem alist)))
+ (value (setcar alist (car elem)) alist)
+ (t 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. Returns the altered alist."
+ (vhdl-asort alist-symbol key)
+ (let ((alist (symbol-value alist-symbol)))
+ (cond ((null alist) nil)
+ ((vhdl-anot-head-p alist key) alist)
+ (t (set alist-symbol (cdr alist))))))
+
+(defun vhdl-aget (alist key &optional keynil-p)
+ "Return the value in ALIST that is associated with KEY.
+Optional KEYNIL-P describes what to do if the value associated with
+KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is
+nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be
+returned.
+
+If no key-value pair matching KEY could be found in ALIST, or ALIST is
+nil then nil is returned. ALIST is not altered."
+ (let ((copy (copy-alist alist)))
+ (cond ((null alist) nil)
+ ((progn (vhdl-asort 'copy key)
+ (vhdl-anot-head-p copy key)) nil)
+ ((cdr (car copy)))
+ (keynil-p nil)
+ ((car (car copy)))
+ (t nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(unless (fboundp 'member-ignore-case)
(defalias 'member-ignore-case 'member))
+;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
+;; behavior in XEmacs
+(defvar vhdl-last-input-event)
+(if (featurep 'xemacs)
+ (defvaralias 'vhdl-last-input-event 'last-input-char)
+ (defvaralias 'vhdl-last-input-event 'last-input-event))
+
+;; `help-print-return-message' changed to `print-help-return-message' in Emacs
+;;;(unless (fboundp 'help-print-return-message)
+;;; (defalias 'help-print-return-message 'print-help-return-message))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compatibility with older VHDL Mode versions
"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)))
(vhdl-warning (apply 'format args) t)
(unless vhdl-warnings
(vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
- (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings))))
+ (push (apply 'format args) vhdl-warnings)))
(defun vhdl-warning (string &optional nobeep)
"Print out warning STRING and beep."
(let ((old-alist vhdl-model-alist)
new-alist)
(while old-alist
- (setq new-alist (cons (append (car old-alist) '("")) new-alist))
+ (push (append (car old-alist) '("")) new-alist)
(setq old-alist (cdr old-alist)))
(setq vhdl-model-alist (nreverse new-alist)))
(customize-save-variable 'vhdl-model-alist vhdl-model-alist))
(let ((old-alist vhdl-project-alist)
new-alist)
(while old-alist
- (setq new-alist (cons (append (car old-alist) '("")) new-alist))
+ (push (append (car old-alist) '("")) new-alist)
(setq old-alist (cdr old-alist)))
(setq vhdl-project-alist (nreverse new-alist)))
(customize-save-variable 'vhdl-project-alist vhdl-project-alist))
(unless (get 'speedbar-indentation-width 'saved-value)
(setq speedbar-indentation-width 2)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Help functions / inline substitutions / macros
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
(progn (set-buffer (create-file-buffer ,file-name))
(setq file-opened t)
(vhdl-insert-file-contents ,file-name)
+ ;; FIXME: This modifies a global syntax-table!
(modify-syntax-entry ?\- ". 12" (syntax-table))
(modify-syntax-entry ?\n ">" (syntax-table))
(modify-syntax-entry ?\^M ">" (syntax-table))
(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."
- (setq list (cons nil list))
+ (push nil list)
(let ((list1 list))
(while (and (cdr list1) (not (equal elt (cadr list1))))
(setq list1 (cdr list1)))
(setcdr list1 (cddr list1))))
(cdr list))
+(declare-function speedbar-refresh "speedbar" (&optional arg))
+(declare-function speedbar-do-function-pointer "speedbar" ())
+
(defun vhdl-speedbar-refresh (&optional key)
"Refresh directory or project with name KEY."
(when (and (boundp 'speedbar-frame)
(menuno 1)
(i 0))
(while remain
- (setq sublist (cons (car remain) sublist))
+ (push (car remain) sublist)
(setq remain (cdr remain))
(setq i (+ i 1))
(if (= i vhdl-menu-max-size)
(progn
- (setq result (cons (cons (format "%s %s" title menuno)
- (nreverse sublist)) result))
+ (push (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result)
(setq i 0)
(setq menuno (+ menuno 1))
(setq sublist '()))))
(and sublist
- (setq result (cons (cons (format "%s %s" title menuno)
- (nreverse sublist)) result)))
+ (push (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result))
(nreverse result))
list))
(define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
(define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
(define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
- ;; backspace/delete key bindings
- (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify)
- (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
- (define-key vhdl-mode-map [delete] 'delete-char)
- (define-key vhdl-mode-map [(meta delete)] 'kill-word))
;; mode specific key bindings
(define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
(define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
(define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
(define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
(define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
+ (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region)
+ (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer)
(define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
(define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
(define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntax table
-(defvar vhdl-mode-syntax-table nil
+(defvar vhdl-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; define punctuation
+ (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)
+ (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 string
+ (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)
+ ;; define parentheses to match
+ (modify-syntax-entry ?\( "()" st)
+ (modify-syntax-entry ?\) ")(" st)
+ (modify-syntax-entry ?\[ "(]" st)
+ (modify-syntax-entry ?\] ")[" st)
+ (modify-syntax-entry ?\{ "(}" st)
+ (modify-syntax-entry ?\} "){" st)
+ st)
"Syntax table used in `vhdl-mode' buffers.")
-(defvar vhdl-mode-ext-syntax-table nil
+(defvar vhdl-mode-ext-syntax-table
+ ;; Extended syntax table including '_' (for simpler search regexps).
+ (let ((st (copy-syntax-table vhdl-mode-syntax-table)))
+ (modify-syntax-entry ?_ "w" st)
+ st)
"Syntax table extended by `_' used in `vhdl-mode' buffers.")
-(defun vhdl-mode-syntax-table-init ()
- "Initialize `vhdl-mode-syntax-table'."
- (setq vhdl-mode-syntax-table (make-syntax-table))
- ;; define punctuation
- (modify-syntax-entry ?\# "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\% "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\& "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\' "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\* "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\. "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\: "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\; "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\< "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\= "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\> "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table)
- (modify-syntax-entry ?\| "." vhdl-mode-syntax-table)
- ;; define string
- (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table)
- ;; define underscore
- (when vhdl-underscore-is-part-of-word
- (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table))
- ;; a single hyphen is punctuation, but a double hyphen starts a comment
- (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)
- ;; and \n and \^M end a comment
- (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table)
- ;; define parentheses to match
- (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table)
- (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table)
- ;; extended syntax table including '_' (for simpler search regexps)
- (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table))
- (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table))
-
-;; initialize syntax table for VHDL Mode
-(vhdl-mode-syntax-table-init)
-
(defvar vhdl-syntactic-context nil
"Buffer local variable containing syntactic analysis list.")
(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)
)))
;; 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)
["Whitespace Region" vhdl-fixup-whitespace-region (mark)]
["Whitespace Buffer" vhdl-fixup-whitespace-buffer t]
"--"
+ ["Statement Region" vhdl-fix-statement-region (mark)]
+ ["Statement Buffer" vhdl-fix-statement-buffer t]
+ "--"
["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t])
("Update"
["Sensitivity List" vhdl-update-sensitivity-list-process t]
["Always"
(customize-set-variable 'vhdl-include-group-comments 'always)
:style radio :selected (eq 'always vhdl-include-group-comments)])
+ ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t]
["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
["Instance Name..." (customize-option 'vhdl-instance-name) t]
("Testbench"
["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
"--"
["Customize Group..." (customize-group 'vhdl-comment) t])
- ("Align"
+ ("Beautify"
["Auto Align Templates"
(customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
:style toggle :selected vhdl-auto-align]
(customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
:style toggle :selected vhdl-align-groups]
["Group Separation String..."
- (customize-set-variable 'vhdl-align-group-separate) t]
+ (customize-option 'vhdl-align-group-separate) t]
["Align Lines with Same Indent"
(customize-set-variable 'vhdl-align-same-indent
(not vhdl-align-same-indent))
:style toggle :selected vhdl-align-same-indent]
+ ["Beautify Options..." (customize-option 'vhdl-beautify-options) t]
"--"
- ["Customize Group..." (customize-group 'vhdl-align) t])
+ ["Customize Group..." (customize-group 'vhdl-beautify) t])
("Highlight"
["Highlighting On/Off..."
(customize-option
(set (make-local-variable 'imenu-generic-expression)
vhdl-imenu-generic-expression)
(when (and vhdl-index-menu (fboundp 'imenu))
- (if (or (not (boundp 'font-lock-maximum-size))
- (> font-lock-maximum-size (buffer-size)))
- (imenu-add-to-menubar "Index")
- (message "Scanning buffer for index...buffer too big"))))
+ (imenu-add-to-menubar "Index")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source file menu (using `easy-menu.el')
(setq found nil)
(while file-list
(setq found t)
- (setq menu-list (cons (vector (car file-list)
- (list 'find-file (car file-list)) t)
- menu-list))
+ (push (vector (car file-list) (list 'find-file (car file-list)) t)
+ menu-list)
(setq file-list (cdr file-list)))
(setq menu-list (vhdl-menu-split menu-list "Sources"))
- (when found (setq menu-list (cons "--" menu-list)))
- (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list))
- (setq menu-list (cons "Sources" menu-list))
+ (when found (push "--" menu-list))
+ (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list)
+ (push "Sources" menu-list)
;; Create menu
(easy-menu-add menu-list)
(easy-menu-define vhdl-sources-menu newmap
(mra) architecture is selected. If another architecture is desired, it
can be marked as most-recently-analyzed (speedbar menu) before
generating the configuration.
-
+
Note: Configurations of subcomponents (i.e. hierarchical configuration
declarations) are currently not considered when displaying
configurations in speedbar.
option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
(e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
file) for browsing the file contents (is not populated if buffer is
- larger than `font-lock-maximum-size'). Also, a source file menu can be
+ larger than 256000). Also, a source file menu can be
added (set option `vhdl-source-file-menu' to non-nil) for browsing the
current directory for VHDL source files.
automatically recognized as VHDL source files. To add an extension
\".xxx\", add the following line to your Emacs start-up file (`.emacs'):
- \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
+ \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
HINTS:
;; 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 '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
(save-excursion
(goto-char new)
(eq new (progn (back-to-indentation) (point)))))
- (setq placeholder new)))
+ (setq placeholder new)))
(vhdl-add-syntax 'statement-cont placeholder)
(if begin-after-ip
(vhdl-add-syntax 'block-open)))
(beginning-of-line 2)
(setq syntax (vhdl-get-syntactic-context)))))
(when is-comment
- (setq syntax (cons (cons 'comment nil) syntax)))
+ (push (cons 'comment nil) syntax))
(apply '+ (mapcar 'vhdl-get-offset syntax)))
;; indent like previous nonblank line
(save-excursion (beginning-of-line)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Alignment, whitespace fixup, beautifying
+;;; Alignment, beautifying
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst vhdl-align-alist
(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)))
(when vhdl-progress-interval
(setq vhdl-progress-info (vector (count-lines (point-min) beg)
(count-lines (point-min) end) 0))))
- (vhdl-fixup-whitespace-region beg end t)
+ (when (nth 0 vhdl-beautify-options)
+ (vhdl-fixup-whitespace-region beg end t))
(goto-char beg)
(if (not vhdl-align-groups)
;; align entire region
;; search for comment start positions and lengths
(while (< (point) end)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
+ (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
(not (save-excursion (goto-char (match-beginning 2))
(vhdl-in-literal))))
(setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
(setq length (- (match-end 2) (match-beginning 2)))
(setq start-max (max start start-max))
(setq length-max (max length length-max))
- (setq comment-list (cons (cons start length) comment-list)))
+ (push (cons start length) comment-list))
(beginning-of-line 2))
(setq comment-list
(sort comment-list (function (lambda (a b) (> (car a) (car b))))))
(unless (or (= (caar comment-list) (car start-list))
(<= (+ (car start-list) (cdar comment-list))
end-comment-column))
- (setq start-list (cons (caar comment-list) start-list)))
+ (push (caar comment-list) start-list))
(setq comment-list (cdr comment-list)))
;; align lines as nicely as possible
(goto-char beg)
(while (< (point) end)
(setq cur-start nil)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
+ (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
(not (save-excursion
(goto-char (match-beginning 3))
(vhdl-in-literal))))
(replace-match "\\2")))
;; surround operator symbols by one space
(goto-char beg)
- (while (re-search-forward "\\(--.*\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")))
(interactive)
(vhdl-fixup-whitespace-region (point-min) (point-max)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Case fixing
+
+(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
+ "Convert all words matching WORD-REGEXP in region to lower or upper case,
+depending on parameter UPPER-CASE."
+ (let ((case-replace nil)
+ (last-update 0))
+ (vhdl-prepare-search-2
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char beg)
+ (while (re-search-forward word-regexp end t)
+ (or (vhdl-in-literal)
+ (if upper-case
+ (upcase-word -1)
+ (downcase-word -1)))
+ (when (and count vhdl-progress-interval (not noninteractive)
+ (< vhdl-progress-interval
+ (- (nth 1 (current-time)) last-update)))
+ (message "Fixing case... (%2d%s)"
+ (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
+ "%")
+ (setq last-update (nth 1 (current-time)))))
+ (goto-char end)))))
+
+(defun vhdl-fix-case-region (beg end &optional arg)
+ "Convert all VHDL words in region to lower or upper case, depending on
+options vhdl-upper-case-{keywords,types,attributes,enum-values}."
+ (interactive "r\nP")
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-types vhdl-types-regexp 1)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
+ (when vhdl-progress-interval (message "Fixing case...done")))
+
+(defun vhdl-fix-case-buffer ()
+ "Convert all VHDL words in buffer to lower or upper case, depending on
+options vhdl-upper-case-{keywords,types,attributes,enum-values}."
+ (interactive)
+ (vhdl-fix-case-region (point-min) (point-max)))
+
+(defun vhdl-fix-case-word (&optional arg)
+ "Convert word after cursor to upper case if necessary."
+ (interactive "p")
+ (save-excursion
+ (when arg (backward-word 1))
+ (vhdl-prepare-search-1
+ (when (and vhdl-upper-case-keywords
+ (looking-at vhdl-keywords-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-types
+ (looking-at vhdl-types-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-attributes
+ (looking-at vhdl-attributes-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-enum-values
+ (looking-at vhdl-enum-values-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-constants
+ (looking-at vhdl-constants-regexp))
+ (upcase-word 1)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Fix statements
+;; - force each statement to be on a separate line except when on same line
+;; with 'end' keyword
+
+(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'."
+ (interactive "r\nP")
+ (vhdl-prepare-search-2
+ (let (point)
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char beg)
+ ;; `begin' keyword
+ (while (re-search-forward
+ "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t)
+ (goto-char (match-end 0))
+ (setq point (point-marker))
+ (when (and (match-string 1)
+ (or (not (match-string 2))
+ (save-excursion (goto-char (match-end 2))
+ (vhdl-in-literal)))
+ (not (save-excursion (goto-char (match-beginning 1))
+ (vhdl-in-literal))))
+ (goto-char (match-beginning 1))
+ (insert "\n")
+ (indent-according-to-mode))
+ (goto-char point))
+ (goto-char beg)
+ ;; `for', `if' keywords
+ (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
+ (goto-char (match-end 1))
+ (setq point (point-marker))
+ ;; 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
+ (beginning-of-line 1)
+ (save-match-data
+ (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
+ (match-beginning 1) t)
+ (not (string-match
+ "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
+ (match-string 1)))))))
+ (goto-char (match-beginning 1))
+ (insert "\n")
+ (indent-according-to-mode))
+ (goto-char point))))))
+
+(defun vhdl-fix-statement-buffer ()
+ "Force statements in buffer on separate line except when on same line
+with 'end' keyword (necessary for correct indentation)."
+ (interactive)
+ (vhdl-fix-statement-region (point-min) (point-max)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Trailing spaces
+
+(defun vhdl-remove-trailing-spaces-region (beg end &optional arg)
+ "Remove trailing spaces in region."
+ (interactive "r\nP")
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char beg)
+ (while (re-search-forward "[ \t]+$" end t)
+ (unless (vhdl-in-literal)
+ (replace-match "" nil nil)))))
+
+(defun vhdl-remove-trailing-spaces ()
+ "Remove trailing spaces in buffer."
+ (interactive)
+ (vhdl-remove-trailing-spaces-region (point-min) (point-max)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Beautify
`vhdl-fix-case-buffer'."
(interactive "r")
(setq end (save-excursion (goto-char end) (point-marker)))
- (vhdl-indent-region beg end)
- (let ((vhdl-align-groups t))
- (vhdl-align-region beg end))
- (vhdl-fix-case-region beg end))
+ (save-excursion ; remove DOS EOL characters in UNIX file
+ (goto-char beg)
+ (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))
+ (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)
+ (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
(defun vhdl-beautify-buffer ()
"Beautify buffer by applying indentation, whitespace fixup, alignment, and
(while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
(goto-char (match-beginning 0))
(condition-case nil (vhdl-update-sensitivity-list) (error "")))
- (message "Updating sensitivity lists...done"))))
+ (message "Updating sensitivity lists...done")))
+ (when noninteractive (save-buffer)))
(defun vhdl-update-sensitivity-list ()
"Update sensitivity list."
(scan-regions-list
'(;; right-hand side of signal/variable assignment
;; (special case: "<=" is relational operator in a condition)
- ((re-search-forward "[<:]=" proc-end t)
- (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
+ ((vhdl-re-search-forward "[<:]=" proc-end t)
+ (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
;; if condition
- ((re-search-forward "^\\s-*if\\>" proc-end t)
- (re-search-forward "\\<then\\>" proc-end t))
+ ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t)
+ (vhdl-re-search-forward "\\<then\\>" proc-end t))
;; elsif condition
- ((re-search-forward "\\<elsif\\>" proc-end t)
- (re-search-forward "\\<then\\>" proc-end t))
+ ((vhdl-re-search-forward "\\<elsif\\>" proc-end t)
+ (vhdl-re-search-forward "\\<then\\>" proc-end t))
;; while loop condition
- ((re-search-forward "^\\s-*while\\>" proc-end t)
- (re-search-forward "\\<loop\\>" proc-end t))
+ ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t)
+ (vhdl-re-search-forward "\\<loop\\>" proc-end t))
;; exit/next condition
- ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
- (re-search-forward ";" proc-end t))
+ ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
+ (vhdl-re-search-forward ";" proc-end t))
;; assert condition
- ((re-search-forward "\\<assert\\>" proc-end t)
- (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
+ ((
vhdl-re-search-forward "\\<assert\\>" proc-end t)
+ (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
;; case expression
- ((re-search-forward "^\\s-*case\\>" proc-end t)
- (re-search-forward "\\<is\\>" proc-end t))
+ ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t)
+ (vhdl-re-search-forward "\\<is\\>" proc-end t))
;; parameter list of procedure call, array index
((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
(1- (point)))
(progn (backward-char) (forward-sexp)
(while (looking-at "(") (forward-sexp)) (point)))))
- name field read-list sens-list signal-list
+ name field read-list sens-list signal-list tmp-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
(goto-char proc-beg)
- (re-search-forward "\\<process\\>" proc-mid t)
+ (
vhdl-re-search-forward "\\<process\\>" proc-mid t)
(if (not (looking-at "[ \t\n\r\f]*("))
(setq sens-beg (point))
- (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
+ (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
(goto-char (match-end 1))
(forward-sexp)
(setq sens-end (1- (point)))
(goto-char sens-beg)
- (while (and (re-search-forward "\\(\\w+\\)" sens-end t)
+ (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t)
(setq sens-list
(cons (downcase (match-string 0)) sens-list))
- (re-search-forward "\\s-*,\\s-*" sens-end t))))
+ (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t))))
(setq signal-list (append visible-list sens-list))
;; search for sequential parts
(goto-char proc-mid)
(while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
- (setq end (re-search-forward "\\<then\\>" proc-end t))
- (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
+ (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)
(vhdl-forward-sexp)
- (setq seq-region-list (cons (cons end (point)) seq-region-list))
+ (push (cons end (point)) seq-region-list)
(beginning-of-line)))
;; scan for signals read in process
(while scan-regions-list
(and tmp-list (< (point) (cdar tmp-list))))))
(while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
(setq name (match-string 1))
+ ;; get array index range
(when vhdl-array-index-record-field-in-sensitivity-list
- (setq field (match-string 2)))
+ (setq field (match-string 2))
+ ;; not use if it includes a variable name
+ (save-match-data
+ (setq tmp-list visible-list)
+ (while (and field tmp-list)
+ (when (string-match
+ (concat "\\<" (car tmp-list) "\\>") field)
+ (setq field nil))
+ (setq tmp-list (cdr tmp-list)))))
(when (and (not (match-string 6)) ; not when formal parameter
(not (and (match-string 5) ; not event attribute
(not (member (downcase (match-string 5))
'("event" "last_event" "transaction")))))
(member (downcase name) signal-list))
- (unless (member-ignore-case (concat name field) read-list)
- (setq read-list (cons (concat name field) read-list))))
+ ;; not add if name or name+field already exists
+ (unless
+ (or (member-ignore-case name read-list)
+ (member-ignore-case (concat name field) read-list))
+ (push (concat name field) read-list))
+ (setq tmp-list read-list)
+ ;; remove existing name+field if name is added
+ (save-match-data
+ (while tmp-list
+ (when (string-match (concat "^" name field "[(.]")
+ (car tmp-list))
+ (setq read-list (delete (car tmp-list) read-list)))
+ (setq tmp-list (cdr tmp-list)))))
(goto-char (match-end 1)))))
(setq scan-regions-list (cdr scan-regions-list)))
;; update sensitivity list
(while (< (point) end)
(when (looking-at "signal[ \t\n\r\f]+")
(goto-char (match-end 0)))
- (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+")
+ (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0))
(when (= 0 (nth 0 (parse-partial-sexp beg (point))))
(if (match-string 2)
;; scan signal name
- (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)")
+ (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0)))
;; scan alias name, check is alias of (declared) signal
- (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\<is[ \t\n\r\f]+\\(\\w+\\)")
+ (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)")
(member (downcase (match-string 2)) signal-list))
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(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
(goto-char end)
(insert ")")))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Miscellaneous
-
-(defun vhdl-remove-trailing-spaces ()
- "Remove trailing spaces in the whole buffer."
- (interactive)
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" (point-max) t)
- (unless (vhdl-in-literal)
- (replace-match "" nil nil))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Electrification
"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
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable it if ARG
is omitted or nil."
- :global t)
+ :global t :group 'vhdl-mode)
(define-minor-mode vhdl-stutter-mode
"Toggle VHDL stuttering mode.
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable it if ARG
is omitted or nil."
- :global t)
+ :global t :group 'vhdl-mode)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stuttering
(defun vhdl-electric-quote (count) "'' --> \""
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (if (= (preceding-char) last-input-event)
+ (if (= (preceding-char) vhdl-last-input-event)
(progn (delete-char -1) (insert-char ?\" 1))
(insert-char ?\' 1))
(self-insert-command count)))
(defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-event)
+ (cond ((= (preceding-char) vhdl-last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert ": ")
(defun vhdl-electric-comma (count) "',,' --> ' <= '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-event)
+ (cond ((= (preceding-char) vhdl-last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "<= ")))
(defun vhdl-electric-period (count) "'..' --> ' => '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-event)
+ (cond ((= (preceding-char) vhdl-last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "=> ")))
(defun vhdl-electric-equal (count) "'==' --> ' == '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-event)
+ (cond ((= (preceding-char) vhdl-last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "== ")))
"[COMPONENT | ENTITY | CONFIGURATION]" " " t))
(setq unit (upcase (or unit "")))
(cond ((equal unit "ENTITY")
- (vhdl-template-field "library name" "." nil nil nil nil
+ (let ((begin (point)))
+ (vhdl-template-field "library name" "." t begin (point) nil
(vhdl-work-library))
(vhdl-template-field "entity name" "(")
(if (vhdl-template-field "[architecture name]" nil t)
(insert ")")
- (delete-char -1)))
+ (delete-char -1))))
((equal unit "CONFIGURATION")
(vhdl-template-field "library name" "." nil nil nil nil
(vhdl-work-library))
(interactive)
(when (vhdl-template-field "target signal")
(insert " <= ")
-; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
-; (insert " "))
(let ((margin (current-column))
(start (point))
position)
(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")
(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")
(let ((definition
(upcase
(or (vhdl-template-field
- "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)
+ "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t)
""))))
(cond ((equal definition "")
(delete-char -4)
((equal definition "FILE")
(vhdl-insert-keyword " OF ")
(vhdl-template-field "type" ";"))
+ ((equal definition "ENUM")
+ (kill-word -1)
+ (insert "(")
+ (setq end-pos (point-marker))
+ (insert ");"))
(t (insert ";")))
(when mid-pos
(setq end-pos (point-marker))
(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
(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))
(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 ")
(backward-word 1)
(vhdl-case-word 1)
(delete-char 1))
- (let ((invoke-char last-command-event)
+ (let ((invoke-char vhdl-last-input-event)
(abbrev-mode -1)
(vhdl-template-invoked-by-hook t))
(let ((caught (catch 'abort
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
;; paste formal and actual generic
(insert (car (nth 0 generic)) " => "
(if no-constants
- (car (nth 0 generic))
+ (vhdl-replace-string vhdl-actual-generic-name
+ (car (nth 0 generic)))
(or (nth 2 generic) "")))
(setq generic-list (cdr generic-list))
(insert (if generic-list "," ")"))
;; paste generic constants
(setq name (nth 0 generic))
(when name
- (insert (car name))
+ (insert (vhdl-replace-string vhdl-actual-generic-name (car name)))
;; paste type
(insert " : " (nth 1 generic))
;; paste initialization
(message "Pasting port as signals...")
(unless no-indent (indent-according-to-mode))
(let ((margin (current-indentation))
- start port names
+ start port names type generic-list port-name constant-name pos
(port-list (nth 2 vhdl-port-list)))
(when port-list
(setq start (point))
(setq names (cdr names))
(when names (insert ", ")))
;; paste type
- (insert " : " (nth 3 port))
+ (setq type (nth 3 port))
+ (setq generic-list (nth 1 vhdl-port-list))
+ (vhdl-prepare-search-1
+ (setq pos 0)
+ ;; replace formal by actual generics
+ (while generic-list
+ (setq port-name (car (nth 0 (car generic-list))))
+ (while (string-match (concat "\\<" port-name "\\>") type pos)
+ (setq constant-name
+ (save-match-data (vhdl-replace-string
+ vhdl-actual-generic-name port-name)))
+ (setq type (replace-match constant-name t nil type))
+ (setq pos (match-end 0)))
+ (setq generic-list (cdr generic-list))))
+ (insert " : " type)
;; paste initialization (inputs only)
(when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
(insert " := "
(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)))
'(try-expand-list
try-expand-list-all-buffers)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Case fixing
-
-(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
- "Convert all words matching WORD-REGEXP in region to lower or upper case,
-depending on parameter UPPER-CASE."
- (let ((case-replace nil)
- (last-update 0))
- (vhdl-prepare-search-2
- (save-excursion
- (goto-char end)
- (setq end (point-marker))
- (goto-char beg)
- (while (re-search-forward word-regexp end t)
- (or (vhdl-in-literal)
- (if upper-case
- (upcase-word -1)
- (downcase-word -1)))
- (when (and count vhdl-progress-interval (not noninteractive)
- (< vhdl-progress-interval
- (- (nth 1 (current-time)) last-update)))
- (message "Fixing case... (%2d%s)"
- (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
- "%")
- (setq last-update (nth 1 (current-time)))))
- (goto-char end)))))
-
-(defun vhdl-fix-case-region (beg end &optional arg)
- "Convert all VHDL words in region to lower or upper case, depending on
-options vhdl-upper-case-{keywords,types,attributes,enum-values}."
- (interactive "r\nP")
- (vhdl-fix-case-region-1
- beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
- (vhdl-fix-case-region-1
- beg end vhdl-upper-case-types vhdl-types-regexp 1)
- (vhdl-fix-case-region-1
- beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
- (vhdl-fix-case-region-1
- beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
- (vhdl-fix-case-region-1
- beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
- (when vhdl-progress-interval (message "Fixing case...done")))
-
-(defun vhdl-fix-case-buffer ()
- "Convert all VHDL words in buffer to lower or upper case, depending on
-options vhdl-upper-case-{keywords,types,attributes,enum-values}."
- (interactive)
- (vhdl-fix-case-region (point-min) (point-max)))
-
-(defun vhdl-fix-case-word (&optional arg)
- "Convert word after cursor to upper case if necessary."
- (interactive "p")
- (save-excursion
- (when arg (backward-word 1))
- (vhdl-prepare-search-1
- (when (and vhdl-upper-case-keywords
- (looking-at vhdl-keywords-regexp))
- (upcase-word 1))
- (when (and vhdl-upper-case-types
- (looking-at vhdl-types-regexp))
- (upcase-word 1))
- (when (and vhdl-upper-case-attributes
- (looking-at vhdl-attributes-regexp))
- (upcase-word 1))
- (when (and vhdl-upper-case-enum-values
- (looking-at vhdl-enum-values-regexp))
- (upcase-word 1))
- (when (and vhdl-upper-case-constants
- (looking-at vhdl-constants-regexp))
- (upcase-word 1)))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Line handling functions
(defun vhdl-line-expand (&optional prefix-arg)
"Hippie-expand current line."
(interactive "P")
+ (require 'hippie-exp)
(let ((case-fold-search t) (case-replace nil)
(hippie-expand-try-functions-list
'(try-expand-line try-expand-line-all-buffers)))
;; print results
(message "\n\
File statistics: \"%s\"\n\
----------------------\n\
+-----------------------\n\
# statements : %5d\n\
# code lines : %5d\n\
# empty lines : %5d\n\
";; 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 t)) 10)
+ (vhdl-adelete 'vhdl-project-alist vhdl-project)
(error ""))
(when not-make-current
(setq vhdl-project current-project))
"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 t)))
(setq vhdl-project-alist
(append vhdl-project-alist
(list (cons new-name project-entry))))
(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
(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+")
- (setq lib-alist (cons (cons (match-string-no-properties 1)
+ (push (cons (match-string-no-properties 1)
(vhdl-match-string-downcase 2))
- lib-alist))))))
+ lib-alist)))))
lib-alist))
(defun vhdl-scan-directory-contents (name &optional project update num-string
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 t)
+ conf-alist (vhdl-aget vhdl-config-alist key t)
+ pack-alist (vhdl-aget vhdl-package-alist key t)
+ ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key t))
+ file-alist (vhdl-aget vhdl-file-alist key t)))
(when (and (not is-directory) (null file-list))
(message "No such file: \"%s\"" name))
(setq files-exist file-list)
file-tmp-list)
(while file-list
(unless (string-match file-exclude-regexp (car file-list))
- (setq file-tmp-list (cons (car file-list) file-tmp-list)))
+ (push (car file-list) file-tmp-list))
(setq file-list (cdr file-list)))
(setq file-list (nreverse file-tmp-list))))
;; do for all files
(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 t))
(lib-alist (vhdl-scan-context-clause)))
(if (nth 1 ent-entry)
(vhdl-warning-when-idle
"Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
ent-name (nth 1 ent-entry) (nth 2 ent-entry)
file-name (vhdl-current-line))
- (setq ent-list (cons 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)))))
+ (push ent-key ent-list)
+ (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 t))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key t))
(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 t))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(lib-alist (vhdl-scan-context-clause))
"Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
conf-name ent-name (nth 1 conf-entry)
(nth 2 conf-entry) file-name conf-line)
- (setq conf-list (cons conf-key conf-list))
+ (push conf-key conf-list)
;; scan for subconfigurations and subentities
(while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t)
(setq inst-comp-key (vhdl-match-string-downcase 3)
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 t))
(pack-line (vhdl-current-line))
(end-of-unit (vhdl-get-end-of-unit))
comp-name func-name comp-alist func-alist lib-alist)
(setq func-alist (nreverse func-alist))
(setq comp-alist (nreverse comp-alist))
(if is-body
- (setq pack-body-list (cons pack-key pack-body-list))
- (setq pack-list (cons pack-key pack-list)))
- (aput
+ (push pack-key pack-body-list)
+ (push pack-key pack-list))
+ (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 t))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key t))
(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)) t))
+ (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
(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
(let ((case-fold-search nil))
(while dir-list
(unless (string-match file-exclude-regexp (car dir-list))
- (setq dir-list-tmp (cons (car dir-list) dir-list-tmp)))
+ (push (car dir-list) dir-list-tmp))
(setq dir-list (cdr dir-list)))
(setq dir-list (nreverse dir-list-tmp))))
(message "Collecting source files...done")
(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
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project dir-name) t))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or project dir-name) t))
+ (pack-alist (vhdl-aget vhdl-package-alist
+ (or project dir-name) t))
+ (ent-inst-list (car (vhdl-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))
+ (file-alist (vhdl-aget vhdl-file-alist (or project dir-name) t))
+ (file-entry (vhdl-aget file-alist file-name t))
(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 t))
(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 t)
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 t)))
+ (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 t)))
+ (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 t))
(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 t))
(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 t))
+ (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key t)
(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 t))
(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) t))
; 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 t))
;; 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 t))
;; 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) t))
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 t) (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 t) (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 t) (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 t) (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 t) (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 t) (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 t)
(current-buffer))
(insert ")\n"))
(setq vhdl-updated-project-list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Add hierarchy browser functionality to speedbar
-(defvar vhdl-speedbar-key-map nil
+(defvar vhdl-speedbar-mode-map nil
"Keymap used when in the VHDL hierarchy browser mode.")
(defvar vhdl-speedbar-menu-items nil
"Additional menu-items to add to speedbar frame.")
+(declare-function speedbar-add-supported-extension "speedbar" (extension))
+(declare-function speedbar-add-mode-functions-list "speedbar" (new-list))
+(declare-function speedbar-make-specialized-keymap "speedbar" ())
+(declare-function speedbar-change-initial-expansion-list "speedbar"
+ (new-default))
+(declare-function speedbar-add-expansion-list "speedbar" (new-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
(speedbar-item-info . vhdl-speedbar-item-info)
(speedbar-line-directory . vhdl-speedbar-line-project)))
;; keymap
- (unless vhdl-speedbar-key-map
- (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap))
- (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line)
- (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line)
- (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line)
- (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line)
- (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level)
- (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all)
- (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy)
- (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component)
- (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration)
- (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra)
- (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design)
- (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy)
- (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches)
+ (unless vhdl-speedbar-mode-map
+ (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
+ (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level)
+ (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all)
+ (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy)
+ (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component)
+ (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration)
+ (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra)
+ (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design)
+ (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy)
+ (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches)
(let ((key 0))
(while (<= key 9)
- (define-key vhdl-speedbar-key-map (int-to-string key)
+ (define-key vhdl-speedbar-mode-map (int-to-string key)
`(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
(setq key (1+ key)))))
- (define-key speedbar-key-map "h"
+ (define-key speedbar-mode-map "h"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl directory")))
- (define-key speedbar-key-map "H"
+ (define-key speedbar-mode-map "H"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl project")))
;; menu
["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
;; hook-ups
(speedbar-add-expansion-list
- '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map
+ '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
vhdl-speedbar-display-directory))
(speedbar-add-expansion-list
- '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map
+ '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
vhdl-speedbar-display-projects))
(setq speedbar-stealthy-function-list
(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"))
"Name of last selected project.")
;; macros must be defined in the file they are used (copied from `speedbar.el')
-(defmacro speedbar-with-writable (&rest forms)
- "Allow the buffer to be writable and evaluate FORMS."
- (list 'let '((inhibit-read-only t))
- (cons 'progn forms)))
-(put 'speedbar-with-writable 'lisp-indent-function 0)
+;;; (defmacro speedbar-with-writable (&rest forms)
+;;; "Allow the buffer to be writable and evaluate FORMS."
+;;; (list 'let '((inhibit-read-only t))
+;;; (cons 'progn forms)))
+;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
+
+(declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
+(declare-function speedbar-directory-buttons "speedbar" (directory _index))
+(declare-function speedbar-file-lists "speedbar" (directory))
(defun vhdl-speedbar-display-directory (directory depth &optional rescan)
"Display directory and hierarchy information in speedbar."
(error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))
(setq speedbar-full-text-cache nil)) ; prevent caching
+(declare-function speedbar-make-tag-line "speedbar"
+ (type char func data tag tfunc tdata tface depth))
+
(defun vhdl-speedbar-insert-projects ()
"Insert all projects in speedbar."
(vhdl-speedbar-make-title-line "Projects:")
(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 t)
+ (vhdl-aget vhdl-config-alist project t)
+ (vhdl-aget vhdl-package-alist project t)
+ (car (vhdl-aget vhdl-ent-inst-alist project t)) 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 t)
+ (vhdl-aget vhdl-config-alist directory t)
+ (vhdl-aget vhdl-package-alist directory t)
+ (car (vhdl-aget vhdl-ent-inst-alist directory t)) 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)
depth)
(setq pack-alist (cdr pack-alist))))))
+(declare-function speedbar-line-directory "speedbar" (&optional depth))
+
(defun vhdl-speedbar-rescan-hierarchy ()
"Rescan hierarchy for the directory or project under the cursor."
(interactive)
(abbreviate-file-name (match-string 1 path)))))
(vhdl-speedbar-refresh key)))
+(declare-function speedbar-goto-this-file "speedbar" (file))
+
(defun vhdl-speedbar-expand-dirs (directory)
"Expand subdirectories in DIRECTORY according to
`speedbar-shown-directories'."
(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 t))
(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))
(setq unit-alist (cdr unit-alist))))))
(vhdl-speedbar-update-current-unit nil t))
+(declare-function speedbar-center-buffer-smartly "speedbar" ())
+
(defun vhdl-speedbar-contract-level ()
"Contract current level in current directory/project."
(interactive)
(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 t))
+ (conf-alist (vhdl-aget vhdl-config-alist key t))
+ (pack-alist (vhdl-aget vhdl-package-alist key t))
arch-alist unit-alist subunit-alist)
(add-to-list 'vhdl-speedbar-shown-project-list key)
(while ent-alist
(setq arch-alist (nth 4 (car ent-alist)))
(setq subunit-alist nil)
(while arch-alist
- (setq subunit-alist (cons (caar arch-alist) subunit-alist))
+ (push (caar arch-alist) subunit-alist)
(setq arch-alist (cdr arch-alist)))
- (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist))
+ (push (list (caar ent-alist) subunit-alist) unit-alist)
(setq ent-alist (cdr ent-alist)))
(while conf-alist
- (setq unit-alist (cons (list (caar conf-alist)) unit-alist))
+ (push (list (caar conf-alist)) unit-alist)
(setq conf-alist (cdr conf-alist)))
(while pack-alist
- (setq unit-alist (cons (list (caar pack-alist)) unit-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))))
+(declare-function speedbar-change-expand-button-char "speedbar" (char))
+(declare-function speedbar-delete-subblock "speedbar" (indent))
+
(defun vhdl-speedbar-expand-project (text token indent)
"Expand/contract the project under the cursor."
(cond
(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 t))
+ (ent-entry (vhdl-aget ent-alist token t))
(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 t)))
+ (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 t)))
+ (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 t))
+ (conf-alist (vhdl-aget vhdl-config-alist key t))
(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) t))
+ (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token) t))
(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 t))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t))))
+ (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 t))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t))))
+ (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 t))
+ (conf-entry (vhdl-aget conf-alist token))
+ (ent-alist (vhdl-aget vhdl-entity-alist key t))
(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 t)))
+ (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 t)))
+ (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 t))
+ (pack-entry (vhdl-aget pack-alist token t))
(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 t)))
+ (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) t))
(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 t)))
+ (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) t))
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 t))
(vhdl-speedbar-make-subpack-line
(or (nth 0 pack-entry) pack-key) lib-name
(cons (nth 1 pack-entry) (nth 2 pack-entry))
(setq vhdl-speedbar-last-selected-project vhdl-project)))
t)
+(declare-function speedbar-position-cursor-on-line "speedbar" ())
+
(defun vhdl-speedbar-update-current-unit (&optional no-position always)
"Highlight all design units that are contained in the current file.
NO-POSITION non-nil means do not re-position cursor."
(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) t)))
(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) t)))
(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 t)))
(vhdl-speedbar-update-units
"\\[.\\] " (nth 0 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-entity-face)
"> " (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 t)))
(setq
pos (vhdl-speedbar-update-units
"\\[.\\] " (nth 0 file-entry)
(setq unit-list (cdr unit-list)))
pos)
+(declare-function speedbar-make-button "speedbar"
+ (start end face mouse function &optional token))
+
(defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
ent-name ent-file-marker
arch-name arch-file-marker
'speedbar-directory-face level)
(setq dirs (cdr dirs)))))
+(declare-function speedbar-reset-scanners "speedbar" ())
+
(defun vhdl-speedbar-dired (text token indent)
"Speedbar click handler for directory expand button in hierarchy mode."
(cond ((string-match "+" text) ; we have to expand this dir
(concat (speedbar-line-directory indent) token))))
(while oldl
(if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
- (setq newl (cons (car oldl) newl)))
+ (push (car oldl) newl))
(setq oldl (cdr oldl)))
(setq speedbar-shown-directories (nreverse newl)))
(speedbar-change-expand-button-char ?+)
(when (equal (selected-frame) speedbar-frame)
(speedbar-center-buffer-smartly)))
+(declare-function speedbar-files-item-info "speedbar" ())
+
(defun vhdl-speedbar-item-info ()
"Derive and display information about this line item."
(save-excursion
(vhdl-default-directory)))))
(t (message "")))))
+(declare-function speedbar-line-text "speedbar" (&optional p))
+
(defun vhdl-speedbar-line-text ()
"Calls `speedbar-line-text' and removes text properties."
(let ((string (speedbar-line-text)))
(setq dir (car path-list))
(string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
(if (file-directory-p (match-string 2 dir))
- (setq path-list-1 (cons dir path-list-1))
+ (push dir path-list-1)
(vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
(setq path-list (cdr path-list)))
;; resolve path wildcards
dir-list)
(while all-list
(when (file-directory-p (car all-list))
- (setq dir-list (cons (car all-list) dir-list)))
+ (push (car all-list) dir-list))
(setq all-list (cdr all-list)))
dir-list))
(cdr path-list-1))))
(string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
(when (file-directory-p (match-string 2 dir))
- (setq path-list-2 (cons dir path-list-2)))
+ (push dir path-list-2))
(setq path-list-1 (cdr path-list-1))))
(nreverse path-list-2)))
(goto-char dest)
nil)))
+(declare-function speedbar-find-file-in-frame "speedbar" (file))
+(declare-function speedbar-set-timer "speedbar" (timeout))
+;; speedbar loads dframe at runtime.
+(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
+
(defun vhdl-speedbar-find-file (text token indent)
"When user clicks on TEXT, load file with name and position in TOKEN.
Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
(recenter))
(vhdl-speedbar-update-current-unit t t)
(speedbar-set-timer dframe-update-speed)
- (speedbar-maybee-jump-to-attached-frame))))
+ (dframe-maybee-jump-to-attached-frame))))
(defun vhdl-speedbar-port-copy ()
"Copy the port of the entity/component or subprogram under the cursor."
(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)) t))
+ (ent-entry (vhdl-aget ent-alist ent-key t)))
(setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
(speedbar-refresh))))
+(declare-function speedbar-line-file "speedbar" (&optional p))
+
(defun vhdl-speedbar-make-design ()
"Make (compile) design unit or directory/project under the cursor."
(interactive)
;; 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) t)
(error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
- (setq constant-alist (cons constant-entry constant-alist))
+ (push constant-entry constant-alist)
(setq constant-name (downcase constant-name))
(if (or (member constant-name single-list)
(member constant-name multi-list))
(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-alist (cons signal-entry signal-alist))
+ (setq signal-entry
+ (cons signal-name
+ (if (match-string 1)
+ (or (vhdl-aget port-alist (match-string 2) t)
+ (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")
;; input signal
(unless (match-string 1)
(setq port-alist (cdr port-alist)))
(vhdl-forward-syntactic-ws))
- (setq inst-alist (cons (list inst-name (nreverse constant-alist)
- (nreverse signal-alist)) inst-alist)))
+ (push (list inst-name (nreverse constant-alist)
+ (nreverse signal-alist)) inst-alist))
;; prepare signal insertion
(vhdl-goto-marker arch-decl-pos)
(forward-line 1)
(while constant-alist
(setq constant-name (downcase (caar constant-alist))
constant-entry (car constant-alist))
+ (unless (string-match "^[0-9]+" constant-name)
(cond ((member constant-name written-list)
nil)
((member constant-name multi-list)
(setq generic-end-pos
(vhdl-compose-insert-generic constant-entry))
(setq generic-inst-pos (point-marker))
- (add-to-list 'written-list constant-name)))
+ (add-to-list 'written-list constant-name))))
(setq constant-alist (cdr constant-alist)))
(when (/= constant-temp-pos generic-inst-pos)
(vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
(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)) t))
(lazy-lock-minimum-size 0)
clause-pos component-pos)
(message "Generating components package \"%s\"..." pack-name)
(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 t))
;; 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) t))
(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)) t))
(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) t))))))
;; 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)) t))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory)) t))
(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) t))
+ (downcase arch-name) t))))
(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)
(setq sublist (nth 11 (car commands-alist)))
(unless (or (equal "" (car sublist))
(assoc (car sublist) regexp-alist))
- (setq regexp-alist (cons (list (nth 0 sublist)
- (if (= 0 (nth 1 sublist))
- (if (featurep 'xemacs) 9 nil)
+ (push (list (nth 0 sublist)
+ (if (and (featurep 'xemacs) (not (nth 1 sublist)))
+ 9
(nth 1 sublist))
(nth 2 sublist) (nth 3 sublist))
- regexp-alist)))
+ regexp-alist))
(setq commands-alist (cdr commands-alist)))
(setq compilation-error-regexp-alist
(append compilation-error-regexp-alist (nreverse regexp-alist))))
(setq sublist (nth 12 (car commands-alist)))
(unless (or (equal "" (car sublist))
(assoc (car sublist) regexp-alist))
- (setq regexp-alist (cons sublist regexp-alist)))
+ (push sublist regexp-alist))
(setq commands-alist (cdr commands-alist)))
(setq compilation-file-regexp-alist
(append compilation-file-regexp-alist (nreverse regexp-alist))))))
&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 nil)
(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))
(compile (concat (if (equal command "") "make" command)
" " options " " vhdl-make-target))))
+;; Emacs 22+ setup
+(defvar vhdl-error-regexp-emacs-alist
+ ;; Get regexps from `vhdl-compiler-alist'
+ (let ((compiler-alist vhdl-compiler-alist)
+ (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
+ (while 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)))))))
+ (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+.")
+
+;; Add error regexps using compilation-mode-hook.
+(defun vhdl-error-regexp-add-emacs ()
+ "Set up Emacs compile for VHDL."
+ (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)
+ (push item compilation-error-regexp-alist-alist))
+ vhdl-error-regexp-emacs-alist)))
+
+(when vhdl-emacs-22
+ (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Makefile generation
(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
(let (pack-list)
(while lib-alist
(when (equal (downcase (caar lib-alist)) (downcase work-library))
- (setq pack-list (cons (cdar lib-alist) pack-list)))
+ (push (cdar lib-alist) pack-list))
(setq lib-alist (cdr lib-alist)))
pack-list))
(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) t))
+ (conf-alist (vhdl-aget vhdl-config-alist (or project directory) t))
+ (pack-alist (vhdl-aget vhdl-package-alist (or project directory) t))
+ (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)
(setq ent-entry (car ent-alist)
ent-key (nth 0 ent-entry))
(when (nth 2 ent-entry)
- (setq ent-file-name (file-relative-name
- (nth 2 ent-entry) compile-directory)
+ (setq ent-file-name (if vhdl-compile-absolute-path
+ (nth 2 ent-entry)
+ (file-relative-name (nth 2 ent-entry)
+ 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)))
- (setq unit-list (cons (cons ent-key tmp-key) unit-list))
+ ent-regexp
+ (funcall adjust-case
+ (concat ent-key " " work-library))))
+ (push (cons ent-key tmp-key) unit-list)
;; rule target for this entity
- (setq target-list (cons ent-key target-list))
+ (push ent-key target-list)
;; rule dependencies for all used packages
(setq pack-list (vhdl-get-packages lib-alist work-library))
(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)
arch-key (nth 0 arch-entry)
ent-arch-key (concat ent-key "-" arch-key)
- arch-file-name (file-relative-name (nth 2 arch-entry)
- compile-directory)
+ arch-file-name (if vhdl-compile-absolute-path
+ (nth 2 arch-entry)
+ (file-relative-name (nth 2 arch-entry)
+ 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))
- (setq second-list (cons ent-arch-key second-list))
+ (push ent-arch-key second-list)
;; rule target for this architecture
- (setq target-list (cons ent-arch-key target-list))
+ (push ent-arch-key target-list)
;; rule dependency for corresponding entity
- (setq depend-list (cons ent-key depend-list))
+ (push ent-key depend-list)
;; rule dependencies for contained component instantiations
(while inst-alist
(setq inst-entry (car inst-alist))
(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)))
- (setq prim-list (cons (list ent-key second-list
- (append subcomp-list all-pack-list))
- prim-list)))
+ (push (list ent-key second-list (append subcomp-list all-pack-list))
+ prim-list))
(setq ent-alist (cdr ent-alist)))
(setq ent-alist tmp-list)
;; rules for all configurations
(while conf-alist
(setq conf-entry (car conf-alist)
conf-key (nth 0 conf-entry)
- conf-file-name (file-relative-name
- (nth 2 conf-entry) compile-directory)
+ conf-file-name (if vhdl-compile-absolute-path
+ (nth 2 conf-entry)
+ (file-relative-name (nth 2 conf-entry)
+ compile-directory))
ent-key (nth 4 conf-entry)
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)))
- (setq unit-list (cons (cons conf-key tmp-key) unit-list))
+ conf-regexp
+ (funcall adjust-case
+ (concat conf-key " " work-library))))
+ (push (cons conf-key tmp-key) unit-list)
;; rule target for this configuration
- (setq target-list (cons conf-key target-list))
+ (push conf-key target-list)
;; rule dependency for corresponding entity and architecture
(setq depend-list
(cons ent-key (cons (concat ent-key "-" arch-key) depend-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
-; (setq depend-list (cons (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))
- (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list))
- prim-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)
;; rules for all packages
pack-key (nth 0 pack-entry)
pack-body-key nil)
(when (nth 2 pack-entry)
- (setq pack-file-name (file-relative-name (nth 2 pack-entry)
- compile-directory)
+ (setq pack-file-name (if vhdl-compile-absolute-path
+ (nth 2 pack-entry)
+ (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)))
- (setq unit-list (cons (cons pack-key tmp-key) unit-list))
+ pack-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
+ (push (cons pack-key tmp-key) unit-list)
;; rule target for this package
- (setq target-list (cons pack-key target-list))
+ (push pack-key target-list)
;; rule dependencies for all used packages
(setq pack-list (vhdl-get-packages lib-alist work-library))
(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")
- pack-body-file-name (file-relative-name (nth 7 pack-entry)
- compile-directory)
- rule (aget rule-alist pack-body-file-name)
+ pack-body-file-name (if vhdl-compile-absolute-path
+ (nth 7 pack-entry)
+ (file-relative-name (nth 7 pack-entry)
+ compile-directory))
+ 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 target-list (cons pack-body-key target-list))
+ (push pack-body-key target-list)
;; rule dependency for corresponding package declaration
- (setq depend-list (cons pack-key depend-list))
+ (push pack-key depend-list)
;; rule dependencies for all used packages
(setq pack-list (vhdl-get-packages lib-body-alist work-library))
(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 t))
+ (nth 0 (vhdl-aget conf-alist unit-key t))
+ (nth 0 (vhdl-aget pack-alist unit-key t))))
(insert "\n" unit-key)
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
(insert " :"
- " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
- " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
- (while second-list
- (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
- (setq second-list (cdr second-list)))
+ " \\\n\t\t" (nth 2 vhdl-makefile-default-targets))
(while subcomp-list
(when (and (assoc (car subcomp-list) unit-list)
(not (equal unit-key (car subcomp-list))))
(insert " \\\n\t\t" (car subcomp-list)))
(setq subcomp-list (cdr subcomp-list)))
+ (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
+ (while second-list
+ (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
+ (setq second-list (cdr second-list)))
(insert "\n")
(setq prim-list (cdr prim-list)))
;; insert rule for each library unit file
(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-include-direction-comments
'vhdl-include-type-comments
'vhdl-include-group-comments
+ 'vhdl-actual-generic-name
'vhdl-actual-port-name
'vhdl-instance-name
'vhdl-testbench-entity-name
(defconst vhdl-doc-release-notes nil
"\
-Release Notes for VHDL Mode 3.33
+Release Notes for VHDL Mode 3.34
================================
- - New Features
- - User Options
+- Added support for GNU Emacs 22/23/24:
+ - Compilation error parsing fixed for new `compile.el' package.
+
+- Port translation: Derive actual generic name from formal generic name.
+
+- New user options:
+ `vhdl-actual-generic-name': Specify how actual generic names are obtained.
+Release Notes for VHDL Mode 3.33
+================================
+
New Features
------------
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-variable variable)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ (documentation-property variable 'variable-documentation))
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-mode)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ mode-name)
HCoop / bpt / emacs.git / blobdiff