From b8a2a63b662e7907ce770f7690f87738b1f6d34e Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 8 Nov 2024 09:54:29 +0100 Subject: [PATCH] Drop hippie-exp.el --- doc/emacs/abbrevs.texi | 4 - doc/misc/Makefile.in | 2 +- doc/misc/autotype.texi | 26 - doc/misc/vhdl-mode.texi | 1022 -- lisp/align.el | 45 +- lisp/emulation/viper-cmd.el | 6 +- lisp/files.el | 1 - lisp/hippie-exp.el | 1094 --- lisp/info-look.el | 1 - lisp/info.el | 4 +- lisp/org/ol-info.el | 2 +- lisp/progmodes/vera-mode.el | 1422 --- lisp/progmodes/vhdl-mode.el | 17992 ---------------------------------- 13 files changed, 9 insertions(+), 21612 deletions(-) delete mode 100644 doc/misc/vhdl-mode.texi delete mode 100644 lisp/hippie-exp.el delete mode 100644 lisp/progmodes/vera-mode.el delete mode 100644 lisp/progmodes/vhdl-mode.el diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi index a00837fe7d0..9b43b227dff 100644 --- a/doc/emacs/abbrevs.texi +++ b/doc/emacs/abbrevs.texi @@ -20,10 +20,6 @@ to expand the letters in the buffer before point by looking for other words in the buffer that start with those letters. @xref{Dynamic Abbrevs}. - A third kind, @dfn{hippie expansion}, generalizes abbreviation expansion. -@xref{Hippie Expand, , Hippie Expansion, autotype, Features for -Automatic Typing}. - @menu * Abbrev Concepts:: Fundamentals of defined abbrevs. * Defining Abbrevs:: Defining an abbrev, so it will expand when typed. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 5653d03ea76..9058e596635 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -72,7 +72,7 @@ INFO_COMMON = auth autotype calc ccmode cl dbus dired-x \ modus-themes newsticker nxml-mode octave-mode org pcl-cvs pgg \ rcirc reftex remember sasl sc ses sieve smtpmail \ speedbar todo-mode tramp transient url use-package \ - vhdl-mode viper vtable widget woman + viper vtable widget woman ## Info files to install on current platform. INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32) diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index 4bd07c8d312..335f949f19d 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -93,7 +93,6 @@ completions and expansions of text at point. * Executables:: Turning interpreter scripts into executables. * Timestamps:: Updating dates and times in modified files. * Tempo:: Flexible template insertion. -* Hippie Expand:: Expansion of text trying various methods. * Skeleton Language:: Making skeleton commands insert what you want. * GNU Free Documentation License:: The license for this documentation. @@ -507,31 +506,6 @@ inserting it. See the commentary in @file{tempo.el} for more information on using the Tempo package. -@node Hippie Expand -@chapter ``Hippie'' Expansion - -@findex hippie-expand -@kindex M-/ -@vindex hippie-expand-try-functions-list -@kbd{M-x hippie-expand} is a single command providing a variety of -completions and expansions. Called repeatedly, it tries all possible -completions in succession. - -Which ones to try, and in which order, is determined by the contents of -the customizable option @code{hippie-expand-try-functions-list}. Much -customization of the expansion behavior can be made by changing the -order of, removing, or inserting new functions in this list. Given a -positive numeric argument, @kbd{M-x hippie-expand} jumps directly that -number of functions forward in this list. Given some other argument (a -negative argument or just @kbd{C-u}) it undoes the tried completion. - -See the commentary in @file{hippie-exp.el} for more information on the -possibilities. - -Typically you would bind @code{hippie-expand} to @kbd{M-/} with -@code{dabbrev-expand}, the standard binding of @kbd{M-/}, providing one -of the expansion possibilities. - @node Skeleton Language @chapter Skeleton Language @cindex skeleton language diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi deleted file mode 100644 index e7eb1025ea4..00000000000 --- a/doc/misc/vhdl-mode.texi +++ /dev/null @@ -1,1022 +0,0 @@ -\input texinfo @c -*- texinfo -*- - -@setfilename ../../info/vhdl-mode.info -@settitle VHDL Mode, an Emacs mode for editing VHDL code -@include docstyle.texi - -@c Adapted from the VHDL Mode texinfo manual version 2 by Rodney J. Whitby. -@c Adapted from the CC Mode texinfo manual by Barry A. Warsaw. - -@copying -This file documents VHDL Mode, an Emacs mode for editing VHDL code. - -Copyright @copyright{} 1995--2008, 2010, 2012, 2015--2024 Free Software -Foundation, Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover texts being ``A GNU Manual,'' -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License.'' - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - -@dircategory Emacs editing modes -@direntry -* VHDL Mode: (vhdl-mode). Emacs mode for editing VHDL code. -@end direntry - -@finalout - -@titlepage -@title VHDL Mode -@sp 2 -@subtitle A GNU Emacs mode for editing VHDL code. -@sp 2 -@author Reto Zimmermann -@author @email{reto@@gnu.org} -@author Rod Whitby -@author @email{software.vhdl-mode@@rwhitby.net} - -@page -@vskip 0pt plus 1filll -@insertcopying -@end titlepage - -@contents - -@ifnottex -@node Top -@top VHDL Mode, an Emacs mode for editing VHDL code - -@insertcopying -@end ifnottex - -@menu -* Introduction:: -* Getting Connected:: -* New Indentation Engine:: -* Customizing Indentation:: -* Syntactic Symbols:: -* Frequently Asked Questions:: -* Getting the latest VHDL Mode release:: -* Sample Init File:: -* Limitations and Known Bugs:: -* Mailing Lists and Submitting Bug Reports:: -* GNU Free Documentation License:: The license for this documentation. -* Concept Index:: -* Command Index:: Command Index -* Key Index:: Key Index -* Variable Index:: Variable Index -@end menu - -@node Introduction -@chapter Introduction -@cindex Introduction - -Welcome to VHDL Mode. This is a GNU Emacs mode for editing files -containing VHDL code. - -This manual will describe the following: - -@itemize @bullet -@item -How to get started using VHDL Mode. - -@item -How the indentation engine works. - -@item -How to customize the indentation engine. - -@end itemize - -@findex vhdl-version -The major version number was incremented to 3 with the addition of -many new features for editing VHDL code to the new indentation engine, -which was introduced in major version 2. To find the minor revision -number of this release, use @kbd{M-x vhdl-version @key{RET}}. - -A special word of thanks goes to Rod Whitby, who wrote the -VHDL Mode indentation engine, and to Barry Warsaw, who wrote -the CC Mode indentation engine that formed the basis -thereof. Their manuals were also the basis for this manual. - -This manual is not very up-to-date. It basically contains the -indentation machine documentation by Rod Whitby with only minor -adaptions. A short documentation of the entire VHDL Mode is available -within the mode itself by typing @kbd{C-c C-h}. Also, all commands and -customization of most variables are available through the menu, which -makes everything highly self-explaining. - -@node Getting Connected -@chapter Getting Connected -@cindex Getting Connected - -To get started, simply visit a @file{.vhd} file in Emacs; or type -@kbd{M-x vhdl-mode @key{RET}}. - -@node New Indentation Engine -@chapter New Indentation Engine -@cindex New Indentation Engine - -VHDL Mode has a new indentation engine, providing a simplified, yet -flexible and general mechanism for customizing indentation. It breaks -indentation calculation into two steps. First for the line of code being -indented, VHDL Mode analyzes what kind of language construct it's -looking at, then it applies user defined offsets to the current line -based on this analysis. - -This section will briefly cover how indentation is calculated in -VHDL Mode. It is important to understand the indentation model -being used so that you will know how to customize VHDL Mode for -your personal coding style. - -@menu -* Syntactic Analysis:: Step 1 -- Syntactic Analysis -* Indentation Calculation:: Step 2 -- Indentation Calculation -@end menu - -@node Syntactic Analysis -@section Syntactic Analysis -@cindex Syntactic Analysis - -@vindex vhdl-offsets-alist -@vindex offsets-alist @r{(vhdl-)} -@cindex relative buffer position -@cindex syntactic symbol -@cindex syntactic component -@cindex syntactic component list -@cindex relative buffer position -The first thing VHDL Mode does when indenting a line of code, is -to analyze the line, determining the @dfn{syntactic component list} of -the construct on that line. A @dfn{syntactic component} consists of a -pair of information (in lisp parlance, a @emph{cons cell}), where the -first part is a @dfn{syntactic symbol}, and the second part is a -@dfn{relative buffer position}. Syntactic symbols describe elements of -VHDL code, e.g., @code{statement}, @code{comment}, @code{block-open}, -@code{block-close}, etc. @xref{Syntactic Symbols}, for a complete list -of currently recognized syntactic symbols and their semantics. Also, -the variable @code{vhdl-offsets-alist} contains the list of currently -supported syntactic symbols. - -Conceptually, a line of VHDL code is always indented relative to the -indentation of some line higher up in the buffer. This is represented -by the relative buffer position in the syntactic component. - -It might help to see an example. Suppose we had the following code as -the only thing in a VHDL Mode buffer @footnote{The line numbers -in this and future examples don't actually appear in the buffer.}: -@example -@group - - 1: inverter : process - 2: begin - 3: q <= not d; - 4: wait on d; - 5: end inverter; - -@end group -@end example - -@kindex C-c C-x -@findex vhdl-show-syntactic-information -@findex show-syntactic-information @r{(vhdl-)} -We can use the command @kbd{C-c C-x} -(@code{vhdl-show-syntactic-information}) to simply report what the -syntactic analysis is for the current line. Running this command on -line 4 of example 1, we'd see in the echo area: -@example - -((statement . 28)) - -@end example - -This tells us that the line is a statement and it is indented relative -to buffer position 28, which happens to be the @samp{q} on line 3. If -you were to move point to line 3 and hit @kbd{C-c C-x}, you would see: -@example - -((statement-block-intro . 20)) - -@end example - -This indicates that line 3 is the first statement in a block, and is -indented relative to buffer position 20, which is the @samp{b} in the -@code{begin} keyword on line 2. - -@cindex comment only line -Syntactic component lists can contain more than one component, and -individual syntactic components need not have relative buffer positions. -The most common example of this is a line that contains a @dfn{comment -only line}. -@example -@group - -%%% TBD %%% - -@end group -@end example - -@noindent -Hitting @kbd{C-c C-x} on line 3 of the example gives us: -@example - -((comment-intro) (block-intro . 46)) - -@end example - -@noindent -so you can see that the syntactic component list contains two syntactic -components. Also notice that the first component, -@samp{(comment-intro)} has no relative buffer position. - -@node Indentation Calculation -@section Indentation Calculation -@cindex Indentation Calculation - -@vindex vhdl-offsets-alist -@vindex offsets-alist @r{(vhdl-)} -Indentation for the current line is calculated using the syntactic -component list derived in step 1 above (@pxref{Syntactic -Analysis}). Each component contributes to the final total indentation -of the line in two ways. - -First, the syntactic symbols are looked up in the @code{vhdl-offsets-alist} -variable, which is an association list of syntactic symbols and the -offsets to apply for those symbols. These offsets are added to the -running total. - -Second, if the component has a relative buffer position, VHDL Mode -adds the column number of that position to the running total. By adding -up the offsets and columns for every syntactic component on the list, -the final total indentation for the current line is computed. - -Let's use our code example above to see how this works. Here is our -example again. -@example -@group - - 1: inverter : process - 2: begin - 3: q <= not d; - 4: wait on d; - 5: end inverter; - -@end group -@end example - -@kindex TAB -Let's say point is on line 3 and we hit the @key{TAB} key to re-indent -the line. Remember that the syntactic component list for that -line is: -@example - -((statement-block-intro . 20)) - -@end example - -@noindent -VHDL Mode looks up @code{statement-block-intro} in the -@code{vhdl-offsets-alist} variable. Let's say it finds the value @samp{2}; -it adds this to the running total (initialized to zero), yielding a -running total indentation of 2 spaces. - -Next VHDL Mode goes to buffer position 20 and asks for the -current column. Since the @code{begin} keyword at buffer position 20 is -in column zero, it adds @samp{0} to the running total. Since there is -only one syntactic component on the list for this line, indentation -calculation is complete, and the total indentation for the line is 2 -spaces. -Simple, huh? - -Actually, the mode usually just does The Right Thing without you having -to think about it in this much detail. But when customizing -indentation, it's helpful to understand the general indentation model -being used. - -@vindex vhdl-echo-syntactic-information-p -@vindex echo-syntactic-information-p @r{(vhdl-)} -@cindex @key{TAB} -To help you configure VHDL Mode, you can set the variable -@code{vhdl-echo-syntactic-information-p} to non-@code{nil} so that the -syntactic component list and calculated offset will always be echoed in -the minibuffer when you hit @kbd{@key{TAB}}. - - -@ignore -@node Indentation Commands -@chapter Indentation Commands -@cindex Indentation Commands - -@strong{} -@end ignore - - -@node Customizing Indentation -@chapter Customizing Indentation -@cindex Customizing Indentation - -@cindex @code{vhdl-set-offset} -@cindex set-offset (vhdl-) -The @code{vhdl-offsets-alist} variable is where you customize all your -indentations. You simply need to decide what additional offset you want -to add for every syntactic symbol. You can use the command @kbd{C-c -O} (@code{vhdl-set-offset}) as the way to set offsets, both -interactively and from your mode hook. Also, you can set up -@emph{styles} of indentation. Most likely, you'll find one of the -pre-defined styles will suit your needs, but if not, this section will -describe how to set up basic editing configurations. @xref{Styles}, for -an explanation of how to set up named styles. - -@cindex @code{vhdl-basic-offset} -@cindex basic-offset (vhdl-) -As mentioned previously, the variable @code{vhdl-offsets-alist} is an -association list between syntactic symbols and the offsets to be applied -for those symbols. In fact, these offset values can be an integer, a -function or variable name, or one of the following symbols: @code{+}, -@code{-}, @code{++}, @code{--}, @code{*}, or @code{/}. The symbol -values have the following meanings: - -@itemize @bullet - -@item -@code{+} -- 1 x @code{vhdl-basic-offset} -@item -@code{-} -- -1 x @code{vhdl-basic-offset} -@item -@code{++} -- 2 x @code{vhdl-basic-offset} -@item -@code{--} -- -2 x @code{vhdl-basic-offset} -@item -@code{*} -- 0.5 x @code{vhdl-basic-offset} -@item -@code{/} -- -0.5 x @code{vhdl-basic-offset} - -@end itemize - -@noindent -So, for example, because most of the default offsets are defined in -terms of @code{+}, @code{-}, and @code{0}, if you like the general -indentation style, but you use 2 spaces instead of 4 spaces per level, -you can probably achieve your style just by changing -@code{vhdl-basic-offset} like so (in your @file{.emacs} file): -@example - -(setq vhdl-basic-offset 2) - -@end example - -To change indentation styles more radically, you will want to change the -value associated with the syntactic symbols in the -@code{vhdl-offsets-alist} variable. First, I'll show you how to do that -interactively, then I'll describe how to make changes to your -@file{.emacs} file so that your changes are more permanent. - -@menu -* Interactive Customization:: -* Permanent Customization:: -* Styles:: -* Advanced Customizations:: -@end menu - -@node Interactive Customization -@section Interactive Customization -@cindex Interactive Customization - -As an example of how to customize indentation, let's change the -style of the example above from: -@example -@group - - 1: inverter : process - 2: begin - 3: q <= not d; - 4: wait on d; - 5: end inverter; - -@end group -@end example -@noindent -to: -@example -@group - - 1: inverter : process - 2: begin - 3: q <= not d; - 4: wait on d; - 5: end inverter; - -@end group -@end example - -In other words, we want to change the indentation of the statements -inside the inverter process. Notice that the construct we want to -change starts on line 3. To change the indentation of a line, we need -to see which syntactic component affect the offset calculations for that -line. Hitting @kbd{C-c C-x} on line 3 yields: -@example - -((statement-block-intro . 20)) - -@end example - -@findex vhdl-set-offset -@findex set-offset @r{(vhdl-)} -@kindex C-c O -@noindent -So we know that to change the offset of the first signal assignment, we need to -change the indentation for the @code{statement-block-intro} syntactic -symbol. To do this interactively, just hit @kbd{C-c O} -(@code{vhdl-set-offset}). This prompts you for the syntactic symbol to -change, providing a reasonable default. In this case, the default is -@code{statement-block-intro}, which is just the syntactic symbol we want to -change! - -After you hit return, VHDL Mode will then prompt you for the new -offset value, with the old value as the default. The default in this -case is @samp{+}, so hit backspace to delete the @samp{+}, then hit -@samp{++} and @kbd{RET}. This will associate an offset of twice the -basic indent with the syntactic symbol @code{statement-block-intro} in -the @code{vhdl-offsets-alist} variable. - -@findex vhdl-indent-defun -@findex indent-defun @r{(vhdl-)} -To check your changes quickly, just enter @kbd{M-x vhdl-indent-defun} to -reindent the entire function. The example should now look like: -@example -@group - - 1: inverter : process - 2: begin - 3: q <= not d; - 4: wait on d; - 5: end inverter; - -@end group -@end example - -Notice how just changing the offset on line 3 is all we needed to do. -Since the other affected lines are indented relative to line 3, they are -automatically indented the way you'd expect. For more complicated -examples, this may not always work. The general approach to take is to -always start adjusting offsets for lines higher up in the file, then -re-indent and see if any following lines need further adjustments. - -@node Permanent Customization -@section Permanent Indentation -@cindex Permanent Indentation - -@vindex vhdl-mode-hook -@cindex hooks -To make this change permanent, you need to add some lisp code to your -@file{.emacs} file. VHDL Mode provides a @code{vhdl-mode-hook} -that you can use to customize your language editing styles. This hook -gets run as the last thing when you enter VHDL Mode. - -Here's a simplified example of what you can add to your @file{.emacs} -file to make the changes described in the previous section -(@ref{Interactive Customization}) more permanent. See the Emacs -manuals for more information on customizing Emacs via hooks. -@xref{Sample Init File}, for a more complete sample @file{.emacs} file. - -@example -@group - -(defun my-vhdl-mode-hook () - ;; my customizations for all of vhdl-mode - (vhdl-set-offset 'statement-block-intro '++) - ;; other customizations can go here - ) -(add-hook 'vhdl-mode-hook 'my-vhdl-mode-hook) - -@end group -@end example - -For complex customizations, you will probably want to set up a -@emph{style} that groups all your customizations under a single -name. @xref{Styles}. - -The offset value can also be a function, and this is how power users -gain enormous flexibility in customizing indentation. @xref{Advanced -Customizations}. - -@node Styles -@section Styles -@cindex Styles - -Most people only need to edit code formatted in just a few well-defined -and consistent styles. For example, their organization might impose a -``blessed'' style that all its programmers must conform to. Similarly, -people who work on GNU software will have to use the GNU coding style on -C code. Some shops are more lenient, allowing some variety of coding -styles, and as programmers come and go, there could be a number of -styles in use. For this reason, VHDL Mode makes it convenient for -you to set up logical groupings of customizations called @dfn{styles}, -associate a single name for any particular style, and pretty easily -start editing new or existing code using these styles. This chapter -describes how to set up styles and how to edit your C code using styles. - -@menu -* Built-in Styles:: -* Adding Styles:: -* File Styles:: -@end menu - - -@node Built-in Styles -@subsection Built-in Styles -@cindex Built-in Styles - -If you're lucky, one of VHDL Mode's built-in styles might be just -what you're looking for. Some of the most common VHDL styles are -already built-in. These include: - -@itemize @bullet -@item -@cindex IEEE style -@code{GNU} -- the coding style in the IEEE Language Reference Manual. - -@end itemize - -@findex vhdl-set-style -@findex set-style @r{(vhdl-)} -If you'd like to experiment with these built-in styles you can simply -type @kbd{M-x vhdl-set-style @key{RET}} in a VHDL Mode buffer. - -You will be prompted for one of the above styles (with completion). -Enter one of the styles and hit @kbd{RET}. Note however that setting a -style in this way does @emph{not} automatically re-indent your file. -@ignore -For commands that you can use to view the effect of your changes, see -@ref{Indentation Commands}. -@end ignore - -Once you find a built-in style you like, you can make the change -permanent by adding a call to your @file{.emacs} file. Let's say for -example that you want to use the @code{IEEE} style in all your -files. You would add this: -@example -@group - -(defun my-vhdl-mode-hook () - ;; use IEEE style for all VHDL code - (vhdl-set-style "IEEE") - ;; other customizations can go here - ) -(add-hook 'vhdl-mode-hook 'my-vhdl-mode-hook) - -@end group -@end example - -@noindent -@xref{Permanent Customization}. - -@node Adding Styles -@subsection Adding Styles -@cindex Adding Styles - -@vindex vhdl-style-alist -@vindex style-alist @r{(vhdl-)} -@findex vhdl-add-style -@findex add-style @r{(vhdl-)} -If none of the built-in styles is appropriate, you'll probably want to -add a new style definition. Styles are kept in the @code{vhdl-style-alist} -variable, but you probably won't want to modify this variable directly. -VHDL Mode provides a function, called @code{vhdl-add-style}, that you -can use to easily add new styles or update existing styles. This -function takes two arguments, a @var{stylename} string, and an -association list @var{description} of style customizations. If -@var{stylename} is not already in @code{vhdl-style-alist}, the new style is -added, otherwise the style already associated with @var{stylename} is -changed to the new @var{description}. This function also takes an -optional third argument, which if non-@code{nil}, automatically -institutes the new style in the current buffer. - -The sample @file{.emacs} file provides a concrete example of how a new -style can be added and automatically set. @xref{Sample Init File}. - -@node File Styles -@subsection File Styles -@cindex File Styles - -@cindex local variables -The Emacs manual describes how you can customize certain variables on a -per-file basis by including a @dfn{Local Variable} block at the end of -the file. So far, you've only seen a functional interface to -VHDL Mode, which is highly inconvenient for use in a Local Variable -block. VHDL Mode provides two variables that make it easier for -you to customize your style on a per-file basis. - -@vindex vhdl-file-style -@vindex file-style @r{(vhdl-)} -@vindex vhdl-file-offsets -@vindex file-offsets @r{(vhdl-)} - -The variable @code{vhdl-file-style} can be set to a style name string as -described in @ref{Built-in Styles}. When the file is visited, -VHDL Mode will automatically set the file's style to this style -using @code{vhdl-set-style}. - -@vindex vhdl-offsets-alist -@vindex offsets-alist @r{(vhdl-)} -@findex vhdl-set-offset -@findex set-offset @r{(vhdl-)} -Another variable, @code{vhdl-file-offsets}, takes an association list -similar to what is allowed in @code{vhdl-offsets-alist}. When the file is -visited, VHDL Mode will automatically institute these offsets using -@code{vhdl-set-offset}. @xref{Customizing Indentation}. - -Note that file style settings (i.e., @code{vhdl-file-style}) are applied -before file offset settings (i.e., @code{vhdl-file-offsets}). - - -@node Advanced Customizations -@section Advanced Customizations -@cindex Advanced Customizations - -@vindex vhdl-style-alist -@vindex style-alist @r{(vhdl-)} -@vindex vhdl-basic-offset -@vindex basic-offset @r{(vhdl-)} -For most users, VHDL Mode will support their coding styles with -very little need for customizations. Usually, one of the standard -styles defined in @code{vhdl-style-alist} will do the trick. Sometimes, -one of the syntactic symbol offsets will need to be tweaked slightly, or -perhaps @code{vhdl-basic-offset} will need to be changed. However, some -styles require a more advanced ability for customization, and one of the -real strengths of VHDL Mode is that the syntactic analysis model -provides a very flexible framework for customizing indentation. This -allows you to perform special indentation calculations for situations -not handled by the mode directly. - -@menu -* Custom Indentation Functions:: -* Other Special Indentations:: -@end menu - -@node Custom Indentation Functions -@subsection Custom Indentation Functions -@cindex Custom Indentation Functions - -@cindex custom indentation functions -One of the most common ways to customize VHDL Mode is by writing -@dfn{custom indentation functions} and associating them with specific -syntactic symbols (@pxref{Syntactic Symbols}). VHDL Mode itself -uses custom indentation functions to provide more sophisticated -indentation, for example when lining up selected signal assignments: -@example -@group - -%%% TBD %%% - -@end group -@end example - -In this example, the @code{statement-cont} syntactic symbol has an -offset of @code{+}, and @code{vhdl-basic-offset} is 2, so lines 4 -through 6 are simply indented two spaces to the right of line 3. But -perhaps we'd like VHDL Mode to be a little more intelligent so -that it offsets the waveform descriptions relative to the signal -assignment operator in line 3. To do this, we have to write a custom -indentation function which finds the column of signal assignment -operator on the first line of the statement. Here is the lisp code -(from the @file{vhdl-mode.el} source file) that implements this: -@example -@group - -(defun vhdl-lineup-statement-cont (langelem) - ;; line up statement-cont after the assignment operator - (save-excursion - (let* ((relpos (cdr langelem)) - (assignp (save-excursion - (goto-char (vhdl-point 'boi)) - (and (re-search-forward "\\(<\\|:\\)=" - (vhdl-point 'eol) t) - (- (point) (vhdl-point 'boi))))) - (curcol (progn - (goto-char relpos) - (current-column))) - foundp) - (while (and (not foundp) - (< (point) (vhdl-point 'eol))) - (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move) - (if (vhdl-in-literal (cdr langelem)) - (forward-char) - (if (= (preceding-char) ?\() - ;; skip over any parenthesized expressions - (goto-char (min (vhdl-point 'eol) - (scan-lists (point) 1 1))) - ;; found an assignment operator (not at eol) - (setq foundp (not (looking-at "\\s-*$")))))) - (if (not foundp) - ;; there's no assignment operator on the line - vhdl-basic-offset - ;; calculate indentation column after assign and ws, unless - ;; our line contains an assignment operator - (if (not assignp) - (progn - (forward-char) - (skip-chars-forward " \t") - (setq assignp 0))) - (- (current-column) assignp curcol)) - ))) - -@end group -@end example -@noindent -Custom indent functions take a single argument, which is a syntactic -component cons cell (@pxref{Syntactic Analysis}). The -function returns an integer offset value that will be added to the -running total indentation for the line. Note that what actually gets -returned is the difference between the column that the signal assignment -operator is on, and the column of the buffer relative position passed in -the function's argument. Remember that VHDL Mode automatically -adds in the column of the component's relative buffer position and we -don't want that value added into the final total twice. - -@cindex statement-cont syntactic symbol -@findex vhdl-lineup-statement-cont -@findex lineup-statement-cont @r{(vhdl-)} -Now, to associate the function @code{vhdl-lineup-statement-cont} with the -@code{statement-cont} syntactic symbol, we can add something like the -following to our @code{vhdl-mode-hook}: -@example - -(vhdl-set-offset 'statement-cont 'vhdl-lineup-statement-cont) - -@end example - -@findex vhdl-indent-defun -Now the function looks like this after re-indenting (using @kbd{M-x -vhdl-indent-defun}): -@example -@group - -%%% TBD %%% - -@end group -@end example - -@vindex vhdl-offsets-alist -@vindex offsets-alist @r{(vhdl-)} -Custom indentation functions can be as simple or as complex as you like, -and any syntactic symbol that appears in @code{vhdl-offsets-alist} can have -a custom indentation function associated with it. Note however that -using many custom indentation functions may have a performance impact on -VHDL Mode. - -@node Other Special Indentations -@subsection Other Special Indentations -@cindex Other Special Indentations - -@vindex vhdl-special-indent-hook -@vindex special-indent-hook @r{(vhdl-)} -One other variable is available for you to customize VHDL Mode: -@code{vhdl-special-indent-hook}. This is a standard hook variable that -is called after every line is indented by VHDL Mode. You can use -it to do any special indentation or line adjustments your style -dictates, such as adding extra indentation to the port map clause in a -component instantiation, etc. Note however, that you should not change -@code{point} or @code{mark} inside your @code{vhdl-special-indent-hook} -functions. - - -@node Syntactic Symbols -@chapter Syntactic Symbols -@cindex Syntactic Symbols - -@vindex vhdl-offsets-alist -The complete list of recognized syntactic symbols is described in the -@code{vhdl-offsets-alist} variable. This chapter will provide some -examples to help clarify these symbols. - -@cindex -open syntactic symbols -@cindex -close syntactic symbols -Most syntactic symbol names follow a general naming convention. When a -line begins with a @code{begin} or @code{end} keyword, the syntactic -symbol will contain the suffix @code{-open} or @code{-close} -respectively. - -@cindex -intro syntactic symbols -@cindex -cont syntactic symbols -@cindex -block-intro syntactic symbols -Usually, a distinction is made between the first line that introduces a -construct and lines that continue a construct, and the syntactic symbols -that represent these lines will contain the suffix @code{-intro} or -@code{-cont} respectively. As a sub-classification of this scheme, a -line which is the first of a particular block construct will contain the -suffix @code{-block-intro}. - -@strong{ include the name and a brief example of every syntactic -symbol currently recognized} - -@node Frequently Asked Questions -@chapter Frequently Asked Questions -@cindex Frequently Asked Questions - -@kindex C-x h -@kindex ESC C-\ -@kindex ESC C-q -@kindex ESC C-u -@kindex RET -@kindex LFD -@findex newline-and-indent -@quotation - -@strong{Q.} @emph{How do I re-indent the whole file?} - -@strong{A.} Visit the file and hit @kbd{C-x h} to mark the whole -buffer. Then hit @kbd{@key{ESC} C-\} to re-indent the entire region -which you've just marked. Or just enter @kbd{M-x vhdl-indent-buffer}. -@sp 2 - -@strong{Q.} @emph{How do I re-indent the entire function?} - -@strong{A.} Hit @kbd{@key{ESC} C-h} to mark the entire function. Then -hit @kbd{@key{ESC} C-\} to re-indent the entire region which you've just -marked. -@sp 2 - -@strong{Q.} @emph{How do I re-indent the current block?} - -@strong{A.} First move to the brace which opens the block with -@kbd{@key{ESC} C-u}, then re-indent that expression with -@kbd{@key{ESC} C-q}. -@sp 2 - -@strong{Q.} @emph{How do I re-indent the current statement?} - -@strong{A.} First move to the beginning of the statement with -@kbd{@key{ESC} a}, then re-indent that expression with @kbd{@key{ESC} -C-q}. -@sp 2 - -@strong{Q.} @emph{I put @code{(vhdl-set-offset 'statement-cont 0)} -in my @file{.emacs} file but I get an error saying that -@code{vhdl-set-offset}'s function definition is void.} - -@strong{A.} This means that VHDL Mode wasn't loaded into your -Emacs session by the time the @code{vhdl-set-offset} call was reached, -mostly likely because VHDL Mode is being autoloaded. Instead -of putting the @code{vhdl-set-offset} line in your top-level -@file{.emacs} file, put it in your @code{vhdl-mode-hook}, or -simply add the following to the top of your @file{.emacs} file: -@example - -(require 'vhdl-mode) - -@end example - -See the sample @file{.emacs} file @ref{Sample Init File} for -details. - -@end quotation - - -@node Getting the latest VHDL Mode release -@chapter Getting the latest VHDL Mode release -@cindex Getting the latest VHDL Mode release - -The best way to be sure you always have the latest VHDL Mode release -is to join the @code{vhdl-mode-announce} mailing list. If you are a -brave soul, and wish to participate in beta testing of new releases of -VHDL Mode, you may also join the @code{vhdl-mode-victims} mailing -list. Send email to the maintainer @email{reto@@gnu.org} to join -either of these lists. - -The official Emacs VHDL Mode Home Page can be found at -@uref{https://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html}. - -@node Sample Init File -@chapter Sample Init File -@cindex Sample init file - -Most customizations can be done using the ``Customize'' entry in the -VHDL Mode menu, which requires no editing of the .emacs file. -If you want to customize indentation, here you go: - -@example -;; Here's a sample .emacs file that might help you along the way. Just -;; copy this region and paste it into your .emacs file. You may want to -;; change some of the actual values. - -(defconst my-vhdl-style - '((vhdl-tab-always-indent . t) - (vhdl-comment-only-line-offset . 4) - (vhdl-offsets-alist . ((arglist-close . vhdl-lineup-arglist) - (statement-cont . 0) - (case-alternative . 4) - (block-open . 0))) - (vhdl-echo-syntactic-information-p . t) - ) - "My VHDL Programming Style") - -;; Customizations for vhdl-mode -(defun my-vhdl-mode-hook () - ;; add my personal style and set it for the current buffer - (vhdl-add-style "PERSONAL" my-vhdl-style t) - ;; offset customizations not in my-vhdl-style - (vhdl-set-offset 'statement-case-intro '++) - ;; other customizations - (setq tab-width 8 - ;; this will make sure spaces are used instead of tabs - indent-tabs-mode nil) - ;; key bindings for VHDL are put in vhdl-mode-map - (define-key vhdl-mode-map "\C-m" 'newline-and-indent) - ) - -(add-hook 'vhdl-mode-hook 'my-vhdl-mode-hook) -@end example - -@node Limitations and Known Bugs -@chapter Limitations and Known Bugs -@cindex Limitations and Known Bugs - -@itemize @bullet -@item -Re-indenting large regions or expressions can be slow. - -@ignore -@item -The index menu does not work on my XEmacs installation (don't know why). -@end ignore - -@end itemize - -@node Mailing Lists and Submitting Bug Reports -@chapter Mailing Lists and Submitting Bug Reports -@cindex Mailing Lists and Submitting Bug Reports - -@kindex C-c C-b -@findex vhdl-submit-bug-report -@findex submit-bug-report @r{(vhdl-)} -@cindex beta testers mailing list -@cindex announcement mailing list -To report bugs, use the @kbd{C-c C-b} (@code{vhdl-submit-bug-report}) -command. This provides vital information I need to reproduce your -problem. Make sure you include a concise, but complete code example. -Please try to boil your example down to just the essential code needed -to reproduce the problem, and include an exact recipe of steps needed to -expose the bug. Be especially sure to include any code that appears -@emph{before} your bug example. - -For other help or suggestions, send a message to @email{reto@@gnu.org}. - -Send an add message to @email{reto@@gnu.org} to get on the -@code{vhdl-mode-victims} beta testers list where beta releases of -VHDL Mode are posted. Note that you shouldn't expect beta -releases to be as stable as public releases. - -There is also an announce only list where the latest public releases -of VHDL Mode are posted. Send an add message to -@email{reto@@gnu.org} to be added to this list. - - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - - -@node Concept Index -@unnumbered Concept Index - -@printindex cp - - -@node Command Index -@unnumbered Command Index - -Since all VHDL Mode commands are prepended with the string -@samp{vhdl-}, each appears under its @code{vhdl-} name and its -@code{ (vhdl-)} name. -@iftex -@sp 2 -@end iftex -@printindex fn - - -@node Key Index -@unnumbered Key Index - -@printindex ky - - -@node Variable Index -@unnumbered Variable Index - -Since all VHDL Mode variables are prepended with the string -@samp{vhdl-}, each appears under its @code{vhdl-} name and its -@code{ (vhdl-)} name. -@iftex -@sp 2 -@end iftex -@printindex vr - -@bye diff --git a/lisp/align.el b/lisp/align.el index 6c393f7ee26..16d502d1a7d 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -197,7 +197,7 @@ If nil, then no messages will ever be printed to the minibuffer." (defcustom align-dq-string-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-base-mode vhdl-mode)) + '(python-base-mode)) "A list of modes where double quoted strings should be excluded." :type '(repeat symbol)) @@ -208,7 +208,7 @@ If nil, then no messages will ever be printed to the minibuffer." (defcustom align-open-comment-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-base-mode makefile-mode vhdl-mode)) + '(python-base-mode makefile-mode)) "A list of modes with a single-line comment syntax. These are comments as in Lisp, which have a beginning, but end with the line (i.e., `comment-end' is an empty string)." @@ -784,47 +784,6 @@ See the variable `align-exclude-rules-list' for more details.") (defvar align-regexp-history nil "Input history for the full user-entered regex in `align-regexp'.") -;; Sample extension rule set for vhdl-mode. This is now obsolete. -(defcustom align-vhdl-rules-list - `((vhdl-declaration - (regexp . "\\(signal\\|variable\\|constant\\)\\(\\s-+\\)\\S-") - (group . 2)) - - (vhdl-case - (regexp . "\\(others\\|[^ \t\n=<]\\)\\(\\s-*\\)=>\\(\\s-*\\)\\S-") - (group . (2 3)) - (valid - . ,(lambda () - (not (string= (downcase (match-string 1)) - "others"))))) - - (vhdl-colon - (regexp . "[^ \t\n:]\\(\\s-*\\):\\(\\s-*\\)[^=\n]") - (group . (1 2))) - - (direction - (regexp . ":\\s-*\\(in\\|out\\|inout\\|buffer\\)\\(\\s-*\\)") - (group . 2)) - - (sig-assign - (regexp . "[^ \t\n=<]\\(\\s-*\\)<=\\(\\s-*\\)\\S-") - (group . (1 2))) - - (var-assign - (regexp . "[^ \t\n:]\\(\\s-*\\):=")) - - (use-entity - (regexp . "\\(\\s-+\\)use\\s-+entity"))) - "Alignment rules for `vhdl-mode'. See `align-rules-list' for more info." - :type align-rules-list-type - :risky t) -(make-obsolete-variable 'align-vhdl-rules-list "no longer used." "27.1") - -(defun align-set-vhdl-rules () - "Setup the `align-mode-rules-list' variable for `vhdl-mode'." - (declare (obsolete nil "27.1")) - (setq align-mode-rules-list align-vhdl-rules-list)) - ;;; User Functions: ;;;###autoload diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index bfe1cca9f87..bcb3780a9af 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -180,7 +180,7 @@ ;; set emacs mode cursor color (viper-change-cursor-color ecolor))) - (if (and (memq this-command '(dabbrev-expand hippie-expand)) + (if (and (eq this-command 'dabbrev-expand) (integerp viper-pre-command-point) (markerp viper-insert-point) (marker-position viper-insert-point) @@ -201,7 +201,7 @@ (defsubst viper-insert-state-pre-command-sentinel () (or (viper-preserve-cursor-color) (viper-restore-cursor-color 'after-insert-mode)) - (if (and (memq this-command '(dabbrev-expand hippie-expand)) + (if (and (eq this-command 'dabbrev-expand) (markerp viper-insert-point) (marker-position viper-insert-point)) (setq viper-pre-command-point (marker-position viper-insert-point)))) @@ -2216,7 +2216,7 @@ problems." ;; deleted. (defun viper-replace-mode-spy-after (beg end length) (if (memq viper-intermediate-command - '(dabbrev-expand hippie-expand repeating-insertion-from-ring)) + '(dabbrev-expand repeating-insertion-from-ring)) ;; Take special care of text insertion from insertion ring inside ;; replacement overlays. (progn diff --git a/lisp/files.el b/lisp/files.el index 4b848faba56..af2716077f0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3092,7 +3092,6 @@ since only a single case-insensitive search through the alist is made." ("\\.m[4c]\\'" . m4-mode) ("\\.mf\\'" . metafont-mode) ("\\.mp\\'" . metapost-mode) - ("\\.vhdl?\\'" . vhdl-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.i?tcl\\'" . tcl-mode) diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el deleted file mode 100644 index 298634c2b7e..00000000000 --- a/lisp/hippie-exp.el +++ /dev/null @@ -1,1094 +0,0 @@ -;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*- - -;; Copyright (C) 1992, 2001-2024 Free Software Foundation, Inc. - -;; Author: Anders Holst -;; Maintainer: emacs-devel@gnu.org -;; Old-Version: 1.6 -;; Keywords: abbrev convenience - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; `hippie-expand' is a single function for a lot of different kinds -;; of completions and expansions. Called repeatedly it tries all -;; possible completions in succession. -;; Which kinds of completions to try, and in which order, is -;; determined by the contents of `hippie-expand-try-functions-list'. -;; Much customization of `hippie-expand' can be made by changing the -;; order of, removing, or inserting new functions in this list. -;; Given a positive numeric argument, `hippie-expand' jumps directly -;; ARG functions forward in this list. Given some other argument -;; (a negative argument or just Ctrl-U) it undoes the tried -;; completion. -;; -;; If the variable `hippie-expand-verbose' is non-nil, `hippie-expand' -;; outputs in a message which try-function in the list that is used -;; currently (i.e. was used currently and will be tried first the next -;; time). -;; The variable `hippie-expand-max-buffers' determines in how many -;; buffers, apart from the current, to search for expansions in. It -;; is used by the try-functions named "-all-buffers". -;; The variable `hippie-expand-ignore-buffers' is a list of regexps -;; matching buffer names (as strings) or major modes (as atoms) of -;; buffers that should not be searched by the try-functions named -;; "-all-buffers". -;; If set, the variable `hippie-expand-only-buffers' does the opposite -;; of `hippie-expand-ignore-buffers', in that the search is restricted -;; to only the kind of buffers listed. -;; If the variable `hippie-expand-no-restriction' is non-nil, narrowed -;; buffers are widened before they are searched. -;; The variable `hippie-expand-dabbrev-skip-space' controls whether -;; trailing spaces will be included in the abbreviation to search for, -;; which then gives the same behavior as the original `dabbrev-expand'. -;; The variable `hippie-expand-dabbrev-as-symbol' controls whether -;; characters of syntax '_' is considered part of the words to expand -;; dynamically. -;; See also the function `make-hippie-expand-function' below. -;; -;; A short description of the current try-functions in this file: -;; `try-complete-file-name' : very convenient to have in any buffer, -;; and not just in the minibuffer or (some) shell-mode. It goes -;; through all possible completions instead of just completing as -;; much as is unique. -;; `try-complete-file-name-partially' : To insert in the list just -;; before `try-complete-file-name' for those who want first to get -;; a file name completed only as many characters as is unique. -;; `try-expand-all-abbrevs' : can be removed if you don't use abbrevs. -;; Otherwise it looks through all abbrev-tables, starting with -;; the local followed by the global. -;; `try-expand-line' : Searches the buffer for an entire line that -;; begins exactly as the current line. Convenient sometimes, for -;; example as a substitute for (or complement to) the history -;; list in shell-like buffers. At other times, only confusing. -;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches -;; in all buffers (except the current). (This may be a little -;; slow, don't use it unless you are really fond of `hippie-expand'.) -;; `try-expand-list' : Tries to expand the text back to the nearest -;; open delimiter, to a whole list from the buffer. Convenient for -;; example when writing Lisp or TeX. -;; `try-expand-list-all-buffers' : Like `try-expand-list' but searches -;; in all buffers (except the current). -;; `try-expand-dabbrev' : works exactly as dabbrev-expand (but of -;; course in a way compatible with the other try-functions). -;; `try-expand-dabbrev-all-buffers' : perhaps the most useful of them, -;; like `dabbrev-expand' but searches all Emacs buffers (except the -;; current) for matching words. (No, I don't find this one -;; particularly slow.) -;; `try-expand-dabbrev-visible': Searches the currently visible parts of -;; all windows. Can be put before `try-expand-dabbrev-all-buffers' to -;; first try the expansions you can see. -;; `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable -;; completion of the word. Good to have, just in case the word was not -;; found elsewhere. -;; `try-expand-whole-kill' : Tries to complete text with a whole entry -;; from the kill ring. May be good if you don't know how far up in -;; the kill-ring the required entry is, and don't want to mess with -;; "Choose Next Paste". -;; `try-complete-lisp-symbol' : like `elisp-completion-at-point', but goes -;; through all possibilities instead of completing what is unique. -;; Might be tedious (usually a lot of possible completions) and -;; since its function is much like `completion-at-point', which -;; already has a key of its own, you might want to remove this. -;; `try-complete-lisp-symbol-partially' : To insert in the list just -;; before `try-complete-lisp-symbol' for those who first want to get -;; completion of what is unique in the name. -;; -;; Not all of the above functions are by default in -;; `hippie-expand-try-functions-list'. This variable is better set -;; in ".emacs" to make `hippie-expand' behave maximally convenient -;; according to personal taste. Also, instead of loading the -;; variable with all kinds of try-functions above, it might be an -;; idea to use `make-hippie-expand-function' to construct different -;; `hippie-expand'-like functions, with different try-lists and bound -;; to different keys. It is also possible to make -;; `hippie-expand-try-functions-list' a buffer local variable, and -;; let it depend on the mode (by setting it in the mode-hooks). -;; -;; To write new try-functions, consider the following: -;; Each try-function takes one argument OLD which is nil the first -;; time the function is called and true in succeeding calls for the -;; same string to complete. The first time the function has to -;; extract the string before point to complete, and substitute the -;; first completion alternative for it. On following calls it has to -;; substitute the next possible completion for the last tried string. -;; The try-function is to return t as long as it finds new -;; possible completions. When there are no more alternatives it has -;; to restore the text before point to its original contents, and -;; return nil (don't beep or message or anything). -;; The try-function can (should) use the following functions: -;; `he-init-string' : Initializes the text to substitute to the -;; contents of the region BEGIN to END. Also sets the variable -;; `he-search-string' to the text to expand. -;; `he-substitute-string' : substitutes STR into the region -;; initialized with `he-init-string'. (An optional second argument -;; TRANS-CASE non-nil, means transfer of case from the abbreviation -;; to the expansion is ok if that is enabled in the buffer.) -;; `he-reset-string' : Resets the initialized region to its original -;; contents. -;; There is also a variable: `he-tried-table' which is meant to contain -;; all tried expansions so far. The try-function can check this -;; variable to see whether an expansion has already been tried -;; (hint: `he-string-member'). -;; -;; Known bugs -;; -;; It may happen that some completion suggestion occurs twice, in -;; spite of the use of `he-tried-table' to prevent that. This is -;; because different try-functions may try to complete different -;; lengths of text, and thus put different amounts of the -;; text in `he-tried-table'. Anyway this seems to occur seldom enough -;; not to be too disturbing. Also it should NOT be possible for the -;; opposite situation to occur, that `hippie-expand' misses some -;; suggestion because it thinks it has already tried it. -;; -;; Acknowledgment -;; -;; I want to thank Mikael Djurfeldt in discussions with whom the idea -;; of this function took form. -;; I am also grateful to all those who have given me suggestions on -;; how to improve it, and all those who helped to find and remove bugs. -;; - -;;; Code: - -(require 'comint) - -(defgroup hippie-expand nil - "Expand text trying various ways to find its expansion." - :link '(custom-manual "(autotype)Hippie Expand") - :link '(emacs-commentary-link "hippie-exp") - :group 'abbrev - :group 'convenience) - -(defvar he-num -1) - -(defvar he-string-beg (make-marker)) - -(defvar he-string-end (make-marker)) - -(defvar he-search-string ()) - -(defvar he-expand-list ()) - -(defvar he-tried-table ()) - -(defvar he-search-loc (make-marker)) - -(defvar he-search-loc2 ()) - -(defvar he-search-bw ()) - -(defvar he-search-bufs ()) - -(defvar he-searched-n-bufs ()) - -(defvar he-search-window ()) - -;;; Autoloaded for historical reasons (bug#12982) -;;;###autoload -(defcustom hippie-expand-try-functions-list - '(try-complete-file-name-partially - try-complete-file-name - try-expand-all-abbrevs - try-expand-list - try-expand-line - try-expand-dabbrev - try-expand-dabbrev-all-buffers - try-expand-dabbrev-from-kill - try-complete-lisp-symbol-partially - try-complete-lisp-symbol) - "The list of expansion functions tried in order by `hippie-expand'. -To change the behavior of `hippie-expand', remove, change the order of, -or insert functions in this list." - :type '(repeat function)) - -(defcustom hippie-expand-verbose t - "Non-nil makes `hippie-expand' output which function it is trying." - :type 'boolean) - -(defcustom hippie-expand-dabbrev-skip-space nil - "Non-nil means tolerate trailing spaces in the abbreviation to expand." - :type 'boolean) - -(defcustom hippie-expand-dabbrev-as-symbol t - "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." - :type 'boolean) - -(defcustom hippie-expand-no-restriction t - "Non-nil means that narrowed buffers are widened during search." - :type 'boolean) - -(defcustom hippie-expand-max-buffers () - "The maximum number of buffers (apart from the current) searched. -If nil, all buffers are searched." - :type '(choice (const :tag "All" nil) - integer)) - -(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) - "A list specifying which buffers not to search (if not current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms)." - :type '(repeat (choice regexp (symbol :tag "Major Mode")))) - -(defcustom hippie-expand-only-buffers () - "A list specifying the only buffers to search (in addition to current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms). If non-nil, this variable overrides the variable -`hippie-expand-ignore-buffers'." - :type '(repeat (choice regexp (symbol :tag "Major Mode")))) - -;;;###autoload -(defun hippie-expand (arg) - "Try to expand text before point, using multiple methods. -The expansion functions in `hippie-expand-try-functions-list' are -tried in order, until a possible expansion is found. Repeated -application of `hippie-expand' inserts successively possible -expansions. -With a positive numeric argument, jumps directly to the ARG next -function in this list. With a negative argument or just \\[universal-argument], -undoes the expansion." - (interactive "P") - (if (or (not arg) - (and (integerp arg) (> arg 0))) - (let ((first (or (= he-num -1) - (not (equal this-command last-command))))) - (if first - (progn - (setq he-num -1) - (setq he-tried-table nil))) - (if arg - (if (not first) (he-reset-string)) - (setq arg 0)) - (let ((i (max (+ he-num arg) 0))) - (while (not (or (>= i (length hippie-expand-try-functions-list)) - (apply (nth i hippie-expand-try-functions-list) - (list (= he-num i))))) - (setq i (1+ i))) - (setq he-num i)) - (if (>= he-num (length hippie-expand-try-functions-list)) - (progn - (setq he-num -1) - (if first - (message "No expansion found") - (message "No further expansions found")) - (ding)) - (if (and hippie-expand-verbose - (not (window-minibuffer-p))) - (message "Using %s" - (nth he-num hippie-expand-try-functions-list))))) - (if (and (>= he-num 0) - (eq (marker-buffer he-string-beg) (current-buffer))) - (progn - (setq he-num -1) - (he-reset-string) - (if (and hippie-expand-verbose - (not (window-minibuffer-p))) - (message "Undoing expansions")))))) - -;; Initializes the region to expand (to between BEG and END). -(defun he-init-string (beg end) - (set-marker he-string-beg beg) - (set-marker he-string-end end) - (setq he-search-string (buffer-substring-no-properties beg end))) - -;; Resets the expanded region to its original contents. -(defun he-reset-string () - (let ((newpos (point-marker))) - (goto-char he-string-beg) - (insert he-search-string) - (delete-region (point) he-string-end) - (goto-char newpos))) - -;; Substitutes an expansion STR into the correct region (the region -;; initialized with `he-init-string'). -;; An optional argument TRANS-CASE means that it is ok to transfer case -;; from the abbreviation to the expansion if that is possible, and is -;; enabled in the buffer. -(defun he-substitute-string (str &optional trans-case) - (let ((trans-case (and trans-case - case-replace - case-fold-search)) - (newpos (point-marker)) - (subst ())) - (goto-char he-string-beg) - (setq subst (if trans-case (he-transfer-case he-search-string str) str)) - (setq he-tried-table (cons subst he-tried-table)) - (insert subst) - (delete-region (point) he-string-end) - (goto-char newpos))) - -(defun he-capitalize-first (str) - (save-match-data - (if (string-match "\\Sw*\\(\\sw\\).*" str) - (let ((res (downcase str)) - (no (match-beginning 1))) - (aset res no (upcase (aref str no))) - res) - str))) - -(defun he-ordinary-case-p (str) - (or (string= str (downcase str)) - (string= str (upcase str)) - (string= str (capitalize str)) - (string= str (he-capitalize-first str)))) - -(defun he-transfer-case (from-str to-str) - (cond ((string= from-str (substring to-str 0 (min (length from-str) - (length to-str)))) - to-str) - ((not (he-ordinary-case-p to-str)) - to-str) - ((string= from-str (downcase from-str)) - (downcase to-str)) - ((string= from-str (upcase from-str)) - (upcase to-str)) - ((string= from-str (he-capitalize-first from-str)) - (he-capitalize-first to-str)) - ((string= from-str (capitalize from-str)) - (capitalize to-str)) - (t - to-str))) - - -;; Check if STR is a member of LST. -;; Transform to the final case if optional TRANS-CASE is non-nil. -(defun he-string-member (str lst &optional trans-case) - (if str - (member (if (and trans-case - case-replace - case-fold-search) - (he-transfer-case he-search-string str) - str) - lst))) - -;; Check if current buffer matches any atom or regexp in LST. -;; Atoms are interpreted as major modes, strings as regexps matching the name. -(defun he-buffer-member (lst) - (or (memq major-mode lst) - (progn - (while (and lst - (or (not (stringp (car lst))) - (not (string-match (car lst) (buffer-name))))) - (setq lst (cdr lst))) - lst))) - -;; For the real hippie-expand enthusiast: A macro that makes it -;; possible to use many functions like hippie-expand, but with -;; different try-functions-lists. -;; Usage is for example: -;; (fset 'my-complete-file (make-hippie-expand-function -;; '(try-complete-file-name-partially -;; try-complete-file-name))) -;; (fset 'my-complete-line (make-hippie-expand-function -;; '(try-expand-line -;; try-expand-line-all-buffers))) -;; -;;;###autoload -(defun make-hippie-expand-function (try-list &optional verbose) - "Construct a function similar to `hippie-expand'. -Make it use the expansion functions in TRY-LIST. An optional second -argument VERBOSE non-nil makes the function verbose." - (lambda (arg) - (:documentation - (concat - "Try to expand text before point, using the following functions: \n" - (mapconcat #'prin1-to-string try-list ", "))) - (interactive "P") - (let ((hippie-expand-try-functions-list try-list) - (hippie-expand-verbose verbose)) - (hippie-expand arg)))) - - -;;; Here follows the try-functions and their requisites: - - -(defun try-complete-file-name (old) - "Try to complete text as a file name. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-file-name-beg) (point)) - (let ((name-part (file-name-nondirectory he-search-string)) - (dir-part (expand-file-name (or (file-name-directory - he-search-string) - "")))) - (if (not (he-string-member name-part he-tried-table)) - (setq he-tried-table (cons name-part he-tried-table))) - (if (and (not (equal he-search-string "")) - (file-directory-p dir-part)) - (setq he-expand-list (sort (file-name-all-completions - name-part - dir-part) - #'string-lessp)) - (setq he-expand-list ()))))) - - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (let ((filename (he-concat-directory-file-name - (file-name-directory he-search-string) - (car he-expand-list)))) - (he-substitute-string filename) - (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-complete-file-name-partially (old) - "Try to complete text as a file name, as many characters as unique. -The argument OLD has to be nil the first call of this function. It -returns t if a unique, possibly partial, completion is found, nil -otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-file-name-beg) (point)) - (let ((name-part (file-name-nondirectory he-search-string)) - (dir-part (expand-file-name (or (file-name-directory - he-search-string) "")))) - (if (and (not (equal he-search-string "")) - (file-directory-p dir-part)) - (setq expansion (file-name-completion name-part - dir-part))) - (if (or (eq expansion t) - (string= expansion name-part) - (he-string-member expansion he-tried-table)) - (setq expansion ()))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (let ((filename (he-concat-directory-file-name - (file-name-directory he-search-string) - expansion))) - (he-substitute-string filename) - (setq he-tried-table (cons expansion (cdr he-tried-table))) - t)))) - -(defvar he-file-name-chars - (cond ((memq system-type '(ms-dos windows-nt cygwin)) - "-a-zA-Z0-9_/.,~^#$+=:\\\\") - (t ;; More strange file formats ? - "-a-zA-Z0-9_/.,~^#$+=")) - "Characters that are considered part of the file name to expand.") - -(defun he-file-name-beg () - (let ((op (point))) - (save-excursion - (skip-chars-backward he-file-name-chars) - (if (> (skip-syntax-backward "w") 0) ;; No words with non-file chars - op - (point))))) - -;; Thanks go to David Hughes who -;; helped to make it work on PC. -(defun he-concat-directory-file-name (dir-part name-part) - "Try to slam together two parts of a file specification, system dependently." - (cond ((null dir-part) name-part) - ((eq system-type 'ms-dos) - (if (and (string-search "\\" dir-part) - (not (string-search "/" dir-part)) - (= (aref name-part (1- (length name-part))) ?/)) - (aset name-part (1- (length name-part)) ?\\)) - (concat dir-part name-part)) - (t - (concat dir-part name-part)))) - -(defun try-complete-lisp-symbol (old) - "Try to complete word as an Emacs Lisp symbol. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-lisp-symbol-beg) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (setq he-tried-table (cons he-search-string he-tried-table))) - (setq he-expand-list - (and (not (equal he-search-string "")) - (sort (all-completions he-search-string obarray - (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym)))) - #'string-lessp))))) - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string (car he-expand-list)) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-complete-lisp-symbol-partially (old) - "Try to complete as an Emacs Lisp symbol, as many characters as unique. -The argument OLD has to be nil the first call of this function. It -returns t if a unique, possibly partial, completion is found, nil -otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-lisp-symbol-beg) (point)) - (if (not (string= he-search-string "")) - (setq expansion - (try-completion he-search-string obarray - (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym)))))) - (if (or (eq expansion t) - (string= expansion he-search-string) - (he-string-member expansion he-tried-table)) - (setq expansion ())))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion) - t)))) - -(defun he-lisp-symbol-beg () - (save-excursion - (skip-syntax-backward "w_") - (point))) - -(defun try-expand-line (old) - "Try to complete the current line to an entire line in the buffer. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (strip-prompt (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp))) - (if (not old) - (progn - (he-init-string (he-line-beg strip-prompt) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-line-search he-search-string - strip-prompt t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-line-search he-search-string - strip-prompt nil)) - (set-marker he-search-loc (point))))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-line-all-buffers (old) - "Try to complete the current line, searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (he--all-buffers - old - (lambda () (he-line-beg (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp))) - (lambda (string) - (he-line-search string - (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp) - nil)))) - -(defun he--all-buffers (old beg-function search-function) - (let ((expansion ()) - (buf (current-buffer)) - (only-buffers hippie-expand-only-buffers) - (ignore-buffers hippie-expand-ignore-buffers) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (funcall beg-function) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if only-buffers - (he-buffer-member only-buffers) - (not (he-buffer-member ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - (goto-char he-search-loc) - (setq expansion - (let ((case-fold-search orig-case-fold-search)) - (funcall search-function he-search-string))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs)))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-line-search (str strip-prompt reverse) - (let ((result ())) - (while (and (not result) - (if reverse - (re-search-backward - (he-line-search-regexp str strip-prompt) - nil t) - (re-search-forward - (he-line-search-regexp str strip-prompt) - nil t))) - (setq result (buffer-substring-no-properties (match-end 1) - (match-end 0))) - (if (he-string-member result he-tried-table t) - (setq result nil))) ; if already in table, ignore - result)) - -(defun he-line-beg (strip-prompt) - (save-excursion - (if (re-search-backward (he-line-search-regexp "" strip-prompt) - (line-beginning-position) t) - (match-beginning 2) - (point)))) - -(defun he-line-search-regexp (pat strip-prompt) - (if strip-prompt - (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(?2:" - (regexp-quote pat) - "[^\n]*[^ \t\n]\\)") - (concat "^\\(\\s-*\\)\\(" - (regexp-quote pat) - "[^\n]*[^ \t\n]\\)"))) - -(defun try-expand-list (old) - "Try to complete the current beginning of a list. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-list-beg) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-list-search he-search-string t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-list-search he-search-string nil)) - (set-marker he-search-loc (point))))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-list-all-buffers (old) - "Try to complete the current list, searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (he--all-buffers old #'he-list-beg #'he-list-search)) - -(defun he-list-search (str &optional reverse) - (let ((result ()) - beg pos err) - (while (and (not result) - (if reverse - (search-backward str nil t) - (search-forward str nil t))) - (setq pos (point)) - (setq beg (match-beginning 0)) - (goto-char beg) - (setq err ()) - (condition-case () - (forward-list 1) - (error (setq err t))) - (if (and reverse - (> (point) he-string-beg)) - (setq err t)) - (if (not err) - (progn - (setq result (buffer-substring-no-properties beg (point))) - (if (he-string-member result he-tried-table t) - (setq result nil)))) ; if already in table, ignore - (goto-char pos)) - result)) - -(defun he-list-beg () - (save-excursion - (condition-case () - (backward-up-list 1) - (error ())) - (point))) - -(defun try-expand-all-abbrevs (old) - "Try to expand word before point according to all abbrev tables. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (and (not (equal he-search-string "")) - (mapcar (lambda (sym) - (if (and (boundp sym) - (abbrev-table-p (symbol-value sym))) - (abbrev-expansion (downcase he-search-string) - (symbol-value sym)))) - (append '(local-abbrev-table - global-abbrev-table) - abbrev-table-name-list)))))) - (while (and he-expand-list - (or (not (car he-expand-list)) - (he-string-member (car he-expand-list) he-tried-table t))) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string (car he-expand-list) t) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-expand-dabbrev (old) - "Try to expand word \"dynamically\", searching the current buffer. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string nil)) - (set-marker he-search-loc (point))))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-dabbrev-all-buffers (old) - "Try to expand word \"dynamically\", searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (he--all-buffers old #'he-dabbrev-beg #'he-dabbrev-search)) - -;; Thanks go to Jeff Dairiki who -;; suggested this one. -(defun try-expand-dabbrev-visible (old) - "Try to expand word \"dynamically\", searching visible window parts. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ()) - (flag (if (frame-visible-p (window-frame)) - 'visible t))) - (unless old - (he-init-string (he-dabbrev-beg) (point)) - (setq he-search-window (selected-window)) - (set-marker he-search-loc - (window-start he-search-window) - (window-buffer he-search-window))) - - (while (and (not (equal he-search-string "")) - (marker-position he-search-loc) - (not expansion)) - (with-current-buffer (marker-buffer he-search-loc) - (save-excursion - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string () - (window-end he-search-window))) - (if (and expansion - (eq (marker-buffer he-string-beg) (current-buffer)) - (eq (marker-position he-string-beg) (match-beginning 0))) - (setq expansion - (he-dabbrev-search he-search-string () - (window-end he-search-window)))) - (set-marker he-search-loc (point) (current-buffer)))) - (unless expansion - (setq he-search-window (next-window he-search-window nil flag)) - (if (eq he-search-window (selected-window)) - (set-marker he-search-loc nil) - (set-marker he-search-loc (window-start he-search-window) - (window-buffer he-search-window))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-dabbrev-search (pattern &optional reverse limit) - (let ((result ()) - (regpat (cond ((not hippie-expand-dabbrev-as-symbol) - (concat "\\<" (regexp-quote pattern) "\\sw+")) - ((eq (char-syntax (aref pattern 0)) ?_) - (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")) - (t - (concat "\\<" (regexp-quote pattern) - "\\(\\sw\\|\\s_\\)+"))))) - (while (and (not result) - (if reverse - (re-search-backward regpat limit t) - (re-search-forward regpat limit t))) - (setq result (buffer-substring-no-properties (match-beginning 0) - (match-end 0))) - (if (or (and hippie-expand-dabbrev-as-symbol - (> (match-beginning 0) (point-min)) - (memq (char-syntax (char-after (1- (match-beginning 0)))) - '(?_ ?w))) - (he-string-member result he-tried-table t)) - (setq result nil))) ; ignore if bad prefix or already in table - result)) - -(defun he-dabbrev-beg () - (let ((op (point))) - (save-excursion - (if hippie-expand-dabbrev-skip-space - (skip-syntax-backward ". ")) - (if (= (skip-syntax-backward (if hippie-expand-dabbrev-as-symbol - "w_" "w")) - 0) - op - (point))))) - -(defun try-expand-dabbrev-from-kill (old) - "Try to expand word \"dynamically\", searching the kill ring. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (if (not (equal he-search-string "")) - kill-ring)) - (setq he-search-loc2 0))) - (if (not (equal he-search-string "")) - (setq expansion (he-dabbrev-kill-search he-search-string))) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-dabbrev-kill-search (pattern) - (let ((result ()) - (regpat (cond ((not hippie-expand-dabbrev-as-symbol) - (concat "\\<" (regexp-quote pattern) "\\sw+")) - ((eq (char-syntax (aref pattern 0)) ?_) - (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")) - (t - (concat "\\<" (regexp-quote pattern) - "\\(\\sw\\|\\s_\\)+")))) - (killstr (car he-expand-list))) - (while (and (not result) - he-expand-list) - (while (and (not result) - (string-match regpat killstr he-search-loc2)) - (setq result (substring killstr (match-beginning 0) (match-end 0))) - (set-text-properties 0 (length result) () result) - (setq he-search-loc2 (1+ (match-beginning 0))) - (if (or (and hippie-expand-dabbrev-as-symbol - (> (match-beginning 0) 0) - (memq (char-syntax (aref killstr (1- (match-beginning 0)))) - '(?_ ?w))) - (he-string-member result he-tried-table t)) - (setq result nil))) ; ignore if bad prefix or already in table - (if (and (not result) - he-expand-list) - (progn - (setq he-expand-list (cdr he-expand-list)) - (setq killstr (car he-expand-list)) - (setq he-search-loc2 0)))) - result)) - -(defun try-expand-whole-kill (old) - "Try to complete text with something from the kill ring. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-kill-beg) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (setq he-tried-table (cons he-search-string he-tried-table))) - (setq he-expand-list - (if (not (equal he-search-string "")) - kill-ring)) - (setq he-search-loc2 ()))) - (if (not (equal he-search-string "")) - (setq expansion (he-whole-kill-search he-search-string))) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion) - t)))) - -(defun he-whole-kill-search (str) - (let ((case-fold-search ()) - (result ()) - (str (regexp-quote str)) - (killstr (car he-expand-list)) - (pos -1)) - (while (and (not result) - he-expand-list) - (if (not he-search-loc2) - (while (setq pos (string-match str killstr (1+ pos))) - (setq he-search-loc2 (cons pos he-search-loc2)))) - (while (and (not result) - he-search-loc2) - (setq pos (car he-search-loc2)) - (setq he-search-loc2 (cdr he-search-loc2)) - (save-excursion - (goto-char he-string-beg) - (if (and (>= (- (point) pos) (point-min)) ; avoid some string GC - (eq (char-after (- (point) pos)) (aref killstr 0)) - (search-backward (substring killstr 0 pos) - (- (point) pos) t)) - (progn - (setq result (substring killstr pos)) - (set-text-properties 0 (length result) () result)))) - (if (and result - (he-string-member result he-tried-table)) - (setq result nil))) ; ignore if already in table - (if (and (not result) - he-expand-list) - (progn - (setq he-expand-list (cdr he-expand-list)) - (setq killstr (car he-expand-list)) - (setq pos -1)))) - result)) - -(defun he-kill-beg () - (let ((op (point))) - (save-excursion - (skip-syntax-backward "^w_") - (if (= (skip-syntax-backward "w_") 0) - op - (point))))) - - -(provide 'hippie-exp) - -;;; hippie-exp.el ends here diff --git a/lisp/info-look.el b/lisp/info-look.el index 392d9da71e6..1928ae7fe5a 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -1080,7 +1080,6 @@ Return nil if there is nothing appropriate in the buffer near point." ("tramp" "Variable Index" "Function Index") ("url" "Variable Index" "Function Index") ("use-package" "Index") - ("vhdl" "(vhdl-mode)Variable Index" "(vhdl-mode)Command Index") ("viper" "Variable Index" "Function Index") ("vtable" "Index") ("widget" "Index") diff --git a/lisp/info.el b/lisp/info.el index de5a3374caf..a375d542641 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -222,7 +222,7 @@ These directories are searched after those in `Info-directory-list'." "mh-e" "modus-themes" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode" - "todo-mode" "tramp" "transient" "url" "use-package" "vhdl-mode" + "todo-mode" "tramp" "transient" "url" "use-package" "viper" "vtable" "widget" "wisent" "woman") . "https://www.gnu.org/software/emacs/manual/html_node/%m/%e")) "Alist telling `Info-mode' where manuals are accessible online. @@ -4734,7 +4734,7 @@ Advanced commands: ("skeleton" . "autotype") ("auto-insert" . "autotype") ("copyright" . "autotype") ("executable" . "autotype") ("time-stamp" . "autotype") - ("tempo" . "autotype") ("hippie-expand" . "autotype") + ("tempo" . "autotype") ("cvs" . "pcl-cvs") ("ada" . "ada-mode") "calc" ("calcAlg" . "calc") ("calcDigit" . "calc") ("calcVar" . "calc") "eshell" "cl" "reftex" "speedbar" "widget" "woman" diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el index 282d528473d..2a4b8d98b71 100644 --- a/lisp/org/ol-info.el +++ b/lisp/org/ol-info.el @@ -135,7 +135,7 @@ If LINK is not an info link then DESC is returned." "mairix-el" "message" "modus-themes" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "transient" - "url" "use-package" "vhdl-mode" "vip" "viper" "vtable" "widget" "wisent" "woman") + "url" "use-package" "vip" "viper" "vtable" "widget" "wisent" "woman") "List of Emacs documents available. Taken from ") diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el deleted file mode 100644 index 184cce66ae4..00000000000 --- a/lisp/progmodes/vera-mode.el +++ /dev/null @@ -1,1422 +0,0 @@ -;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*- - -;; Copyright (C) 1997-2024 Free Software Foundation, Inc. - -;; Author: Reto Zimmermann -;; Version: 2.28 -;; Keywords: languages vera -;; URL: https://iis-people.ee.ethz.ch/~zimmi/emacs/vera-mode.html - -;; Yoni Rabkin contacted the maintainer of this -;; file on 18/3/2008, and the maintainer agreed that when a bug is -;; 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 vera-version "2.18" - "Vera Mode version number.") - -(defconst vera-time-stamp "2007-06-21" - "Vera Mode time stamp for last update.") - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This package provides a simple Emacs major mode for editing Vera code. -;; It includes the following features: - -;; - Syntax highlighting -;; - Indentation -;; - Word/keyword completion -;; - Block commenting - -;; Documentation - -;; See comment string of function `vera-mode' or type `C-h m' in Emacs. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup vera nil - "Customizations for Vera Mode." - :prefix "vera-" - :version "22.2" - :group 'languages) - -(defcustom vera-basic-offset 2 - "Amount of basic offset used for indentation." - :type 'integer) - -(defcustom vera-underscore-is-part-of-word 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." - :type 'boolean) -(make-obsolete-variable 'vera-underscore-is-part-of-word - 'superword-mode "24.4") - -(defcustom vera-intelligent-tab t - "Non-nil means `TAB' does indentation, word completion and tab insertion. -That is, if preceding character is part of a word then complete word, -else if not at beginning of line then insert tab, -else if last command was a `TAB' or `RET' then dedent one step, -else indent current line. -If nil, TAB always indents current line." - :type 'boolean) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mode definitions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Key bindings - -(defvar vera-mode-map - (let ((map (make-sparse-keymap))) - ;; Backspace/delete key bindings. - (define-key map [backspace] 'backward-delete-char-untabify) - ;; Standard key bindings. - (define-key map "\M-e" 'vera-forward-statement) - (define-key map "\M-a" 'vera-backward-statement) - (define-key map "\M-\C-e" 'vera-forward-same-indent) - (define-key map "\M-\C-a" 'vera-backward-same-indent) - ;; Mode specific key bindings. - (define-key map "\C-c\t" 'indent-according-to-mode) - (define-key map "\M-\C-\\" 'vera-indent-region) - (define-key map "\C-c\C-c" 'vera-comment-uncomment-region) - (define-key map "\C-c\C-v" 'vera-version) - (define-key map "\M-\t" 'tab-to-tab-stop) - ;; Electric key bindings. - (define-key map "\t" 'vera-electric-tab) - (define-key map "\r" 'vera-electric-return) - (define-key map " " 'vera-electric-space) - (define-key map "{" 'vera-electric-opening-brace) - (define-key map "}" 'vera-electric-closing-brace) - (define-key map "#" 'vera-electric-pound) - (define-key map "*" 'vera-electric-star) - (define-key map "/" 'vera-electric-slash) - map) - "Keymap for Vera Mode.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Menu - -(easy-menu-define vera-mode-menu vera-mode-map - "Menu keymap for Vera Mode." - '("Vera" - ["(Un)Comment Out Region" vera-comment-uncomment-region (mark)] - "--" - ["Move Forward Statement" vera-forward-statement t] - ["Move Backward Statement" vera-backward-statement t] - ["Move Forward Same Indent" vera-forward-same-indent t] - ["Move Backward Same Indent" vera-backward-same-indent t] - "--" - ["Indent Line" indent-according-to-mode t] - ["Indent Region" vera-indent-region (mark)] - ["Indent Buffer" vera-indent-buffer t] - "--" - ["Documentation" describe-mode] - ["Version" vera-version t] - ["Bug Report..." vera-submit-bug-report t] - "--" - ("Options" - ["Indentation Offset..." (customize-option 'vera-basic-offset) t] - ["Underscore is Part of Word" - (customize-set-variable 'vera-underscore-is-part-of-word - (not vera-underscore-is-part-of-word)) - :style toggle :selected vera-underscore-is-part-of-word] - ["Use Intelligent Tab" - (customize-set-variable 'vera-intelligent-tab - (not vera-intelligent-tab)) - :style toggle :selected vera-intelligent-tab] - "--" - ["Save Options" customize-save-customized t] - "--" - ["Customize..." vera-customize t]))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Syntax table - -(defvar vera-mode-syntax-table - (let ((syntax-table (make-syntax-table))) - ;; punctuation - (modify-syntax-entry ?\# "." syntax-table) - (modify-syntax-entry ?\$ "." syntax-table) - (modify-syntax-entry ?\% "." syntax-table) - (modify-syntax-entry ?\& "." syntax-table) - (modify-syntax-entry ?\' "." syntax-table) - (modify-syntax-entry ?\* "." syntax-table) - (modify-syntax-entry ?\- "." syntax-table) - (modify-syntax-entry ?\+ "." syntax-table) - (modify-syntax-entry ?\. "." syntax-table) - (modify-syntax-entry ?\/ "." syntax-table) - (modify-syntax-entry ?\: "." syntax-table) - (modify-syntax-entry ?\; "." syntax-table) - (modify-syntax-entry ?\< "." syntax-table) - (modify-syntax-entry ?\= "." syntax-table) - (modify-syntax-entry ?\> "." syntax-table) - (modify-syntax-entry ?\\ "." syntax-table) - (modify-syntax-entry ?\| "." syntax-table) - ;; string - (modify-syntax-entry ?\" "\"" syntax-table) - ;; underscore - (when vera-underscore-is-part-of-word - (modify-syntax-entry ?\_ "w" syntax-table)) - ;; escape - (modify-syntax-entry ?\\ "\\" syntax-table) - ;; parentheses to match - (modify-syntax-entry ?\( "()" syntax-table) - (modify-syntax-entry ?\) ")(" syntax-table) - (modify-syntax-entry ?\[ "(]" syntax-table) - (modify-syntax-entry ?\] ")[" syntax-table) - (modify-syntax-entry ?\{ "(}" syntax-table) - (modify-syntax-entry ?\} "){" syntax-table) - ;; comment - (modify-syntax-entry ?\/ ". 124b" syntax-table) - (modify-syntax-entry ?\* ". 23" syntax-table) - ;; newline and CR - (modify-syntax-entry ?\n "> b" syntax-table) - (modify-syntax-entry ?\^M "> b" syntax-table) - syntax-table) - "Syntax table used in `vera-mode' buffers.") - -(defvar vera-mode-ext-syntax-table - (let ((syntax-table (copy-syntax-table vera-mode-syntax-table))) - ;; extended syntax table including '_' (for simpler search regexps) - (modify-syntax-entry ?_ "w" syntax-table) - syntax-table) - "Syntax table extended by `_' used in `vera-mode' buffers.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Mode definition - -;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) - -;;;###autoload -(define-derived-mode vera-mode prog-mode "Vera" - "Major mode for editing Vera code. - -Usage: ------- - - INDENTATION: Typing `TAB' at the beginning of a line indents the line. - The amount of indentation is specified by option `vera-basic-offset'. - Indentation can be done for an entire region (`M-C-\\') or buffer (menu). - `TAB' always indents the line if option `vera-intelligent-tab' is nil. - - WORD/COMMAND COMPLETION: Typing `TAB' after a (not completed) word looks - for a word in the buffer or a Vera keyword that starts alike, inserts it - and adjusts case. Re-typing `TAB' toggles through alternative word - completions. - - Typing `TAB' after a non-word character inserts a tabulator stop (if not - at the beginning of a line). `M-TAB' always inserts a tabulator stop. - - COMMENTS: `C-c C-c' comments out a region if not commented out, and - uncomments a region if already commented out. - - HIGHLIGHTING (fontification): Vera keywords, predefined types and - constants, function names, declaration names, directives, as well as - comments and strings are highlighted using different colors. - - VERA VERSION: OpenVera 1.4 and Vera version 6.2.8. - - -Maintenance: ------------- - -To submit a bug report, use the corresponding menu entry within Vera Mode. -Add a description of the problem and include a reproducible test case. - -Feel free to send questions and enhancement requests to . - -Official distribution is at -URL `https://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html' - - - The Vera Mode Maintainer - Reto Zimmermann - -Key bindings: -------------- - -\\{vera-mode-map}" - ;; set local variables - (require 'cc-cmds) - (set (make-local-variable 'comment-start) "//") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-column) 40) - (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") - (set (make-local-variable 'comment-end-skip) " *\\*+/\\| *\n") - (set (make-local-variable 'comment-indent-function) 'c-comment-indent) - (set (make-local-variable 'paragraph-start) "^$") - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'indent-tabs-mode) nil) - (set (make-local-variable 'indent-line-function) 'vera-indent-line) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - ;; initialize font locking - (set (make-local-variable 'font-lock-defaults) - '(vera-font-lock-keywords nil nil ((?\_ . "w")))) - ;; miscellaneous - (message "Vera Mode %s. Type C-c C-h for documentation." vera-version)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Vera definitions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Keywords - -(defconst vera-keywords - '( - "after" "all" "any" "around" "assoc_index" "assoc_size" "async" - "bad_state" "bad_trans" "before" "begin" "big_endian" "bind" - "bin_activation" "bit_normal" "bit_reverse" "break" "breakpoint" - "case" "casex" "casez" "class" "constraint" "continue" - "coverage" "coverage_block" "coverage_def" "coverage_depth" - "coverage_goal" "coverage_group" "coverage_option" "coverage_val" - "cross_num_print_missing" "cross_auto_bin_max" "cov_comment" - "default" "depth" "dist" "do" - "else" "end" "enum" "exhaustive" "export" "extends" "extern" - "for" "foreach" "fork" "function" - "hdl_task" "hdl_node" "hide" - "if" "illegal_self_transition" "illegal_state" "illegal_transition" - "in" "interface" "invisible" - "join" - "little_endian" "local" - "m_bad_state" "m_bad_trans" "m_state" "m_trans" - "negedge" "new" "newcov" "non_rand" "none" "not" "null" - "or" "ordered" - "packed" "port" "posedge" "proceed" "prod" "prodget" "prodset" - "program" "protected" "public" - "rand" "randc" "randcase" "randseq" "repeat" "return" "rules" - "sample" "sample_event" "shadow" "soft" "state" "static" "super" - "task" "terminate" "this" "trans" "typedef" - "unpacked" - "var" "vca" "vector" "verilog_node" "verilog_task" - "vhdl_node" "vhdl_task" "virtual" "virtuals" "visible" "void" - "while" "wildcard" "with" - ) - "List of Vera keywords.") - -(defconst vera-types - '( - "integer" "bit" "reg" "string" "bind_var" "event" - "inout" "input" "output" - "ASYNC" "CLOCK" - "NDRIVE" "NHOLD" "NRX" "NRZ" "NR0" "NR1" "NSAMPLE" - "PDRIVE" "PHOLD" "PRX" "PRZ" "PR0" "PR1" "PSAMPLE" - ) - "List of Vera predefined types.") - -(defconst vera-q-values - '( - "gnr" "grx" "grz" "gr0" "gr1" - "nr" "rx" "rz" "r0" "r1" - "snr" "srx" "srz" "sr0" "sr1" - ) - "List of Vera predefined VCA q_values.") - -(defconst vera-functions - '( - ;; system functions and tasks - "alloc" - "call_func" "call_task" "cast_assign" "close_conn" "cm_coverage" - "cm_get_coverage" "cm_get_limit" - "coverage_backup_database_file" "coverage_save_database" - "delay" - "error" "error_mode" "error_wait" "exit" - "fclose" "feof" "ferror" "fflush" "flag" "fopen" "fprintf" "freadb" - "freadb" "freadh" "freadstr" - "get_bind" "get_bind_id" "get_conn_err" "get_cycle" "get_env" - "get_memsize" "get_plus_arg" "get_systime" "get_time" "get_time_unit" - "getstate" - "initstate" - "lock_file" - "mailbox_get" "mailbox_put" "mailbox_receive" "mailbox_send" - "make_client" "make_server" - "os_command" - "printf" "psprintf" - "query" "query_str" "query_x" - "rand48" "random" "region_enter" "region_exit" "rewind" - "semaphore_get" "semaphore_put" "setstate" "signal_connect" "simwave_plot" - "srandom" "sprintf" "sscanf" "stop" "suspend_thread" "sync" - "timeout" "trace" "trigger" - "unit_delay" "unlock_file" "up_connections" - "urand48" "urandom" "urandom_range" - "vera_bit_reverse" "vera_crc" "vera_pack" "vera_pack_big_endian" - "vera_plot" "vera_report_profile" "vera_unpack" "vera_unpack_big_endian" - "vsv_call_func" "vsv_call_task" "vsv_close_conn" "vsv_get_conn_err" - "vsv_make_client" "vsv_make_server" "vsv_up_connections" - "vsv_wait_for_done" "vsv_wait_for_input" - "wait_child" "wait_var" - ;; class methods - "Configure" "DisableTrigger" "DoAction" "EnableCount" "EnableTrigger" - "Event" "GetAssert" "GetCount" "GetFirstAssert" "GetName" "GetNextAssert" - "Wait" - "atobin" "atohex" "atoi" "atooct" - "backref" "bittostr" "capacity" "compare" "constraint_mode" - "delete" - "empty" - "find" "find_index" "first" "first_index" - "get_at_least" "get_auto_bin" "get_cov_weight" "get_coverage_goal" - "get_cross_bin_max" "get_status" "get_status_msg" "getc" - "hash" - "icompare" "insert" "inst_get_at_least" "inst_get_auto_bin_max" - "inst_get_collect" "inst_get_cov_weight" "inst_get_coverage_goal" - "inst_getcross_bin_max" "inst_query" "inst_set_at_least" - "inst_set_auto_bin_max" "inst_set_bin_activation" "inst_set_collect" - "inst_set_cov_weight" "inst_set_coverage_goal" "inst_set_cross_bin_max" - "itoa" - "last" "last_index" "len" "load" - "match" "max" "max_index" "min" "min_index" - "object_compare" "object_copy" "object_print" - "pack" "pick_index" "pop_back" "pop_front" "post_pack" "post_randomize" - "post_unpack" "postmatch" "pre_pack" "pre_randomize" "prematch" "push_back" - "push_front" "putc" - "query" "query_str" - "rand_mode" "randomize" "reserve" "reverse" "rsort" - "search" "set_at_least" "set_auto_bin_max" "set_bin_activation" - "set_cov_weight" "set_coverage_goal" "set_cross_bin_max" "set_name" "size" - "sort" "substr" "sum" - "thismatch" "tolower" "toupper" - "unique_index" "unpack" - ;; empty methods - "new" "object_compare" - "post_boundary" "post_pack" "post_randomize" "post_unpack" "pre-randomize" - "pre_boundary" "pre_pack" "pre_unpack" - ) - "List of Vera predefined system functions, tasks and class methods.") - -(defconst vera-constants - '( - "ALL" "ANY" - "BAD_STATE" "BAD_TRANS" - "CALL" "CHECK" "CHGEDGE" "CLEAR" "COPY_NO_WAIT" "COPY_WAIT" - "CROSS" "CROSS_TRANS" - "DEBUG" "DELETE" - "EC_ARRAYX" "EC_CODE_END" "EC_CONFLICT" "EC_EVNTIMOUT" "EC_EXPECT" - "EC_FULLEXPECT" "EC_MBXTMOUT" "EC_NEXPECT" "EC_RETURN" "EC_RGNTMOUT" - "EC_SCONFLICT" "EC_SEMTMOUT" "EC_SEXPECT" "EC_SFULLEXPECT" "EC_SNEXTPECT" - "EC_USERSET" "EQ" "EVENT" - "FAIL" "FIRST" "FORK" - "GE" "GOAL" "GT" "HAND_SHAKE" "HI" "HIGH" "HNUM" - "LE" "LIC_EXIT" "LIC_PRERR" "LIC_PRWARN" "LIC_WAIT" "LO" "LOAD" "LOW" "LT" - "MAILBOX" "MAX_COM" - "NAME" "NE" "NEGEDGE" "NEXT" "NO_OVERLAP" "NO_OVERLAP_STATE" - "NO_OVERLAP_TRANS" "NO_VARS" "NO_WAIT" "NUM" "NUM_BIN" "NUM_DET" - "OFF" "OK" "OK_LAST" "ON" "ONE_BLAST" "ONE_SHOT" "ORDER" - "PAST_IT" "PERCENT" "POSEDGE" "PROGRAM" - "RAWIN" "REGION" "REPORT" - "SAMPLE" "SAVE" "SEMAPHORE" "SET" "SILENT" "STATE" "STR" - "STR_ERR_OUT_OF_RANGE" "STR_ERR_REGEXP_SYNTAX" "SUM" - "TRANS" - "VERBOSE" - "WAIT" - "stderr" "stdin" "stdout" - ) - "List of Vera predefined constants.") - -(defconst vera-rvm-types - '( - "VeraListIterator_VeraListIterator_rvm_log" - "VeraListIterator_rvm_data" "VeraListIterator_rvm_log" - "VeraListNodeVeraListIterator_rvm_log" "VeraListNodervm_data" - "VeraListNodervm_log" "VeraList_VeraListIterator_rvm_log" - "VeraList_rvm_data" "VeraList_rvm_log" - "rvm_broadcast" "rvm_channel_class" "rvm_data" "rvm_data" "rvm_env" - "rvm_log" "rvm_log_modifier" "rvm_log_msg" "rvm_log_msg" "rvm_log_msg_info" - "rvm_log_watchpoint" "rvm_notify" "rvm_notify_event" - "rvm_notify_event_config" "rvm_scheduler" "rvm_scheduler_election" - "rvm_watchdog" "rvm_watchdog_port" "rvm_xactor" "rvm_xactor_callbacks" - ) - "List of Vera-RVM keywords.") - -(defconst vera-rvm-functions - '( - "extern_rvm_atomic_gen" "extern_rvm_channel" "extern_rvm_scenario_gen" - "rvm_OO_callback" "rvm_atomic_gen" "rvm_atomic_gen_callbacks_decl" - "rvm_atomic_gen_decl" "rvm_atomic_scenario_decl" "rvm_channel" - "rvm_channel_" "rvm_channel_decl" "rvm_command" "rvm_cycle" "rvm_debug" - "rvm_error" "rvm_fatal" "rvm_note" "rvm_protocol" "rvm_report" - "rvm_scenario_decl" "rvm_scenario_election_decl" "rvm_scenario_gen" - "rvm_scenario_gen_callbacks_decl" "rvm_scenario_gen_decl" - "rvm_trace" "rvm_transaction" "rvm_user" "rvm_verbose" "rvm_warning" - ) - "List of Vera-RVM functions.") - -(defconst vera-rvm-constants - '( - "RVM_NUMERIC_VERSION_MACROS" "RVM_VERSION" "RVM_MINOR" "RVM_PATCH" - "rvm_channel__SOURCE" "rvm_channel__SINK" "rvm_channel__NO_ACTIVE" - "rvm_channel__ACT_PENDING" "rvm_channel__ACT_STARTED" - "rvm_channel__ACT_COMPLETED" "rvm_channel__FULL" "rvm_channel__EMPTY" - "rvm_channel__PUT" "rvm_channel__GOT" "rvm_channel__PEEKED" - "rvm_channel__ACTIVATED" "rvm_channel__STARTED" "rvm_channel__COMPLETED" - "rvm_channel__REMOVED" "rvm_channel__LOCKED" "rvm_channel__UNLOCKED" - "rvm_data__EXECUTE" "rvm_data__STARTED" "rvm_data__ENDED" - "rvm_env__CFG_GENED" "rvm_env__BUILT" "rvm_env__DUT_CFGED" - "rvm_env__STARTED" "rvm_env__RESTARTED" "rvm_env__ENDED" "rvm_env__STOPPED" - "rvm_env__CLEANED" "rvm_env__DONE" "rvm_log__DEFAULT" "rvm_log__UNCHANGED" - "rvm_log__FAILURE_TYP" "rvm_log__NOTE_TYP" "rvm_log__DEBUG_TYP" - "rvm_log__REPORT_TYP" "rvm_log__NOTIFY_TYP" "rvm_log__TIMING_TYP" - "rvm_log__XHANDLING_TYP" "rvm_log__PROTOCOL_TYP" "rvm_log__TRANSACTION_TYP" - "rvm_log__COMMAND_TYP" "rvm_log__CYCLE_TYP" "rvm_log__USER_TYP_0" - "rvm_log__USER_TYP_1" "rvm_log__USER_TYP_2" "rvm_log__USER_TYP_3" - "rvm_log__DEFAULT_TYP" "rvm_log__ALL_TYPES" "rvm_log__FATAL_SEV" - "rvm_log__ERROR_SEV" "rvm_log__WARNING_SEV" "rvm_log__NORMAL_SEV" - "rvm_log__TRACE_SEV" "rvm_log__DEBUG_SEV" "rvm_log__VERBOSE_SEV" - "rvm_log__HIDDEN_SEV" "rvm_log__IGNORE_SEV" "rvm_log__DEFAULT_SEV" - "rvm_log__ALL_SEVERITIES" "rvm_log__CONTINUE" "rvm_log__COUNT_AS_ERROR" - "rvm_log__DEBUGGER" "rvm_log__DUMP" "rvm_log__STOP" "rvm_log__ABORT" - "rvm_notify__ONE_SHOT_TRIGGER" "rvm_notify__ONE_BLAST_TRIGGER" - "rvm_notify__HAND_SHAKE_TRIGGER" "rvm_notify__ON_OFF_TRIGGER" - "rvm_xactor__XACTOR_IDLE" "rvm_xactor__XACTOR_BUSY" - "rvm_xactor__XACTOR_STARTED" "rvm_xactor__XACTOR_STOPPED" - "rvm_xactor__XACTOR_RESET" "rvm_xactor__XACTOR_SOFT_RST" - "rvm_xactor__XACTOR_FIRM_RST" "rvm_xactor__XACTOR_HARD_RST" - "rvm_xactor__XACTOR_PROTOCOL_RST" "rvm_broadcast__AFAP" - "rvm_broadcast__ALAP" "rvm_watchdog__TIMEOUT" - "rvm_env__DUT_RESET" "rvm_log__INTERNAL_TYP" - "RVM_SCHEDULER_IS_XACTOR" "RVM_BROADCAST_IS_XACTOR" - ) - "List of Vera-RVM predefined constants.") - -(defconst vera-keywords-regexp - (concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>") - "Regexp for Vera keywords.") - -(defconst vera-types-regexp - (concat "\\<\\(" (regexp-opt vera-types) "\\)\\>") - "Regexp for Vera predefined types.") - -(defconst vera-q-values-regexp - (concat "\\<\\(" (regexp-opt vera-q-values) "\\)\\>") - "Regexp for Vera predefined VCA q_values.") - -(defconst vera-functions-regexp - (concat "\\<\\(" (regexp-opt vera-functions) "\\)\\>") - "Regexp for Vera predefined system functions, tasks and class methods.") - -(defconst vera-constants-regexp - (concat "\\<\\(" (regexp-opt vera-constants) "\\)\\>") - "Regexp for Vera predefined constants.") - -(defconst vera-rvm-types-regexp - (concat "\\<\\(" (regexp-opt vera-rvm-types) "\\)\\>") - "Regexp for Vera-RVM keywords.") - -(defconst vera-rvm-functions-regexp - (concat "\\<\\(" (regexp-opt vera-rvm-functions) "\\)\\>") - "Regexp for Vera-RVM predefined system functions, tasks and class methods.") - -(defconst vera-rvm-constants-regexp - (concat "\\<\\(" (regexp-opt vera-rvm-constants) "\\)\\>") - "Regexp for Vera-RVM predefined constants.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Font locking -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vera-font-lock-match-item (limit) - "Match, and move over, any declaration item after point. -Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." - (condition-case nil - (save-restriction - (narrow-to-region (point-min) limit) - ;; match item - (when (looking-at "\\s-*\\(\\w+\\)") - (save-match-data - (goto-char (match-end 1)) - ;; move to next item - (if (looking-at "\\(\\s-*\\(\\[[^]]*\\]\\s-*\\)?,\\)") - (goto-char (match-end 1)) - (end-of-line) t)))) - (error t))) - -(defvar vera-font-lock-keywords - (list - ;; highlight keywords - (list vera-keywords-regexp 1 'font-lock-keyword-face) - ;; highlight types - (list vera-types-regexp 1 'font-lock-type-face) - ;; highlight RVM types - (list vera-rvm-types-regexp 1 'font-lock-type-face) - ;; highlight constants - (list vera-constants-regexp 1 'font-lock-constant-face) - ;; highlight RVM constants - (list vera-rvm-constants-regexp 1 'font-lock-constant-face) - ;; highlight q_values - (list vera-q-values-regexp 1 'font-lock-constant-face) - ;; highlight predefined functions, tasks and methods - (list vera-functions-regexp 1 'vera-font-lock-function) - ;; highlight predefined RVM functions - (list vera-rvm-functions-regexp 1 'vera-font-lock-function) - ;; highlight functions - '("\\<\\(\\w+\\)\\s-*(" 1 font-lock-function-name-face) - ;; highlight various declaration names - '("^\\s-*\\(port\\|program\\|task\\)\\s-+\\(\\w+\\)\\>" - 2 font-lock-function-name-face) - '("^\\s-*bind\\s-+\\(\\w+\\)\\s-+\\(\\w+\\)\\>" - (1 font-lock-function-name-face) (2 font-lock-function-name-face)) - ;; highlight interface declaration names - '("^\\s-*\\(class\\|interface\\)\\s-+\\(\\w+\\)\\>" - 2 vera-font-lock-interface) - ;; highlight variable name definitions - (list (concat "^\\s-*" vera-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") - '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) - (list (concat "^\\s-*" vera-rvm-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") - '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) - ;; highlight numbers - '("\\([0-9]*'[bdoh][[:xdigit:]xXzZ_]+\\)" 1 vera-font-lock-number) - ;; highlight filenames in #include directives - '("^#\\s-*include\\s-*\\(<[^>\"\n]*>?\\)" - 1 font-lock-string-face) - ;; highlight directives and directive names - '("^#\\s-*\\(\\w+\\)\\>[ \t!]*\\(\\w+\\)?" - (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t)) - ;; highlight `@', `$' and `#' - '("\\([@$#]\\)" 1 font-lock-keyword-face) - ;; highlight @ and # definitions - '("@\\s-*\\(\\w*\\)\\(\\s-*,\\s-*\\(\\w+\\)\\)?\\>[^.]" - (1 vera-font-lock-number) (3 vera-font-lock-number nil t)) - ;; highlight interface signal name - '("\\(\\w+\\)\\.\\w+" 1 vera-font-lock-interface) - ) - "Regular expressions to highlight in Vera Mode.") - -(defvar vera-font-lock-number 'vera-font-lock-number - "Face name to use for @ definitions.") - -(defvar vera-font-lock-function 'vera-font-lock-function - "Face name to use for predefined functions and tasks.") - -(defvar vera-font-lock-interface 'vera-font-lock-interface - "Face name to use for interface names.") - -(defface vera-font-lock-number - '((((class color) (background light)) :foreground "Gold4") - (((class color) (background dark)) :foreground "BurlyWood1") - (t :slant italic :weight bold)) - "Font lock mode face used to highlight @ definitions." - :group 'font-lock-highlighting-faces) - -(defface vera-font-lock-function - '((((class color) (background light)) :foreground "DarkCyan") - (((class color) (background dark)) :foreground "Orchid1") - (t :slant italic :weight bold)) - "Font lock mode face used to highlight predefined functions and tasks." - :group 'font-lock-highlighting-faces) - -(defface vera-font-lock-interface - '((((class color) (background light)) :foreground "Grey40") - (((class color) (background dark)) :foreground "Grey80") - (t :slant italic :weight bold)) - "Font lock mode face used to highlight interface names." - :group 'font-lock-highlighting-faces) - -(define-obsolete-function-alias 'vera-fontify-buffer - 'font-lock-fontify-buffer "25.1") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Indentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar vera-echo-syntactic-information-p nil - "If non-nil, syntactic info is echoed when the line is indented.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; offset functions - -(defconst vera-offsets-alist - '((comment . vera-lineup-C-comments) - (comment-intro . vera-lineup-comment) - (string . -1000) - (directive . -1000) - (block-open . 0) - (block-intro . +) - (block-close . 0) - (arglist-intro . +) - (arglist-cont . +) - (arglist-cont-nonempty . 0) - (arglist-close . 0) - (statement . 0) - (statement-cont . +) - (substatement . +) - (else-clause . 0)) - "Association list of syntactic element symbols and indentation offsets. -Adapted from `c-offsets-alist'.") - -(defun vera-evaluate-offset (offset langelem symbol) - "OFFSET can be a number, a function, a variable, a list, or one of -the symbols + or -." - (cond - ((eq offset '+) (setq offset vera-basic-offset)) - ((eq offset '-) (setq offset (- vera-basic-offset))) - ((eq offset '++) (setq offset (* 2 vera-basic-offset))) - ((eq offset '--) (setq offset (* 2 (- vera-basic-offset)))) - ((eq offset '*) (setq offset (/ vera-basic-offset 2))) - ((eq offset '/) (setq offset (/ (- vera-basic-offset) 2))) - ((functionp offset) (setq offset (funcall offset langelem))) - ((listp offset) - (setq offset - (let (done) - (while (and (not done) offset) - (setq done (vera-evaluate-offset (car offset) langelem symbol) - offset (cdr offset))) - (if (not done) - 0 - done)))) - ((not (numberp offset)) (setq offset (symbol-value offset)))) - offset) - -(defun vera-get-offset (langelem) - "Get offset from LANGELEM which is a cons cell of the form: -\(SYMBOL . RELPOS). The symbol is matched against -vera-offsets-alist and the offset found there is either returned, -or added to the indentation at RELPOS. If RELPOS is nil, then -the offset is simply returned." - (let* ((symbol (car langelem)) - (relpos (cdr langelem)) - (match (assq symbol vera-offsets-alist)) - (offset (cdr-safe match))) - (if (not match) - (setq offset 0 - relpos 0) - (setq offset (vera-evaluate-offset offset langelem symbol))) - (+ (if (and relpos - (< relpos (line-beginning-position))) - (save-excursion - (goto-char relpos) - (current-column)) - 0) - (vera-evaluate-offset offset langelem symbol)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; help functions - -(defsubst vera-point (position) - "Return the value of point at certain commonly referenced POSITIONs. -POSITION can be one of the following symbols: - bol -- beginning of line - eol -- end of line - boi -- back to indentation - ionl -- indentation of next line - iopl -- indentation of previous line - bonl -- beginning of next line - bopl -- beginning of previous line -This function does not modify point or mark." - (save-excursion - (cond - ((eq position 'bol) (beginning-of-line)) - ((eq position 'eol) (end-of-line)) - ((eq position 'boi) (back-to-indentation)) - ((eq position 'bonl) (forward-line 1)) - ((eq position 'bopl) (forward-line -1)) - ((eq position 'iopl) (forward-line -1) (back-to-indentation)) - ((eq position 'ionl) (forward-line 1) (back-to-indentation)) - (t (error "Unknown buffer position requested: %s" position))) - (point))) - -(defun vera-in-literal (&optional lim) - "Determine if point is in a Vera literal." - (save-excursion - (let ((state (parse-partial-sexp (or lim (point-min)) (point)))) - (cond - ((nth 3 state) 'string) - ((nth 4 state) 'comment) - (t nil))))) - -(defun vera-skip-forward-literal () - "Skip forward literal and return t if within one." - (let ((state (save-excursion (syntax-ppss)))) - (when (nth 8 state) - ;; Inside a string or comment. - (goto-char (nth 8 state)) - (if (nth 3 state) - ;; A string. - (condition-case nil (forward-sexp 1) - ;; Can't find end of string: it extends til end of buffer. - (error (goto-char (point-max)))) - ;; A comment. - (forward-comment 1)) - t))) - -(defun vera-skip-backward-literal () - "Skip backward literal and return t if within one." - (let ((state (save-excursion (syntax-ppss)))) - (when (nth 8 state) - ;; Inside a string or comment. - (goto-char (nth 8 state)) - t))) - -(defsubst vera-re-search-forward (regexp &optional bound noerror) - "Like `re-search-forward', but skips over matches in literals." - (let (ret) - (while (and (setq ret (re-search-forward regexp bound noerror)) - (vera-skip-forward-literal) - (if bound (< (point) bound) t))) - ret)) - -(defsubst vera-re-search-backward (regexp &optional bound noerror) - "Like `re-search-backward', but skips over matches in literals." - (let (ret) - (while (and (setq ret (re-search-backward regexp bound noerror)) - (vera-skip-backward-literal) - (if bound (> (point) bound) t))) - ret)) - -(defun vera-forward-syntactic-ws (&optional lim skip-directive) - "Forward skip of syntactic whitespace." - (save-restriction - (let* ((lim (or lim (point-max))) - (here lim) - (hugenum (point-max))) - (narrow-to-region (point) lim) - (while (/= here (point)) - (setq here (point)) - (forward-comment hugenum) - (when (and skip-directive (looking-at "^\\s-*#")) - (end-of-line)))))) - -(defun vera-backward-syntactic-ws (&optional lim skip-directive) - "Backward skip over syntactic whitespace." - (save-restriction - (let* ((lim (or lim (point-min))) - (here lim) - (hugenum (- (point-max)))) - (when (< lim (point)) - (narrow-to-region lim (point)) - (while (/= here (point)) - (setq here (point)) - (forward-comment hugenum) - (when (and skip-directive - (save-excursion (back-to-indentation) - (= (following-char) ?\#))) - (beginning-of-line))))))) - -(defmacro vera-prepare-search (&rest body) - "Execute BODY with a syntax table that includes `_'." - `(with-syntax-table vera-mode-ext-syntax-table ,@body)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; comment indentation functions - -(defsubst vera-langelem-col (langelem &optional preserve-point) - "Convenience routine to return the column of LANGELEM's relpos. -Leaves point at the relpos unless PRESERVE-POINT is non-nil." - (let ((here (point))) - (goto-char (cdr langelem)) - (prog1 (current-column) - (if preserve-point - (goto-char here))))) - -(defun vera-lineup-C-comments (langelem) - "Line up C block comment continuation lines. -Nicked from `c-lineup-C-comments'." - (save-excursion - (let ((here (point)) - (stars (progn (back-to-indentation) - (skip-chars-forward "*"))) - (langelem-col (vera-langelem-col langelem))) - (back-to-indentation) - (if (not (re-search-forward "/\\([*]+\\)" (vera-point 'eol) t)) - (progn - (if (not (looking-at "[*]+")) - (progn - ;; we now have to figure out where this comment begins. - (goto-char here) - (back-to-indentation) - (if (looking-at "[*]+/") - (progn (goto-char (match-end 0)) - (forward-comment -1)) - (goto-char (cdr langelem)) - (back-to-indentation)))) - (- (current-column) langelem-col)) - (if (zerop stars) - (progn - (skip-chars-forward " \t") - (- (current-column) langelem-col)) - ;; how many stars on comment opening line? if greater than - ;; on current line, align left. if less than or equal, - ;; align right. this should also pick up Javadoc style - ;; comments. - (if (> (length (match-string 1)) stars) - (progn - (back-to-indentation) - (- (current-column) -1 langelem-col)) - (- (current-column) stars langelem-col))))))) - -(defun vera-lineup-comment (langelem) - "Line up a comment start." - (save-excursion - (back-to-indentation) - (if (bolp) - ;; not indent if at beginning of line - -1000 - ;; otherwise indent accordingly - (goto-char (cdr langelem)) - (current-column)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; move functions - -(defconst vera-beg-block-re "{\\|\\<\\(begin\\|fork\\)\\>") - -(defconst vera-end-block-re "}\\|\\<\\(end\\|join\\(\\s-+\\(all\\|any\\|none\\)\\)?\\)\\>") - -(defconst vera-beg-substatement-re "\\<\\(else\\|for\\|if\\|repeat\\|while\\)\\>") - -(defun vera-corresponding-begin (&optional recursive) - "Find corresponding block begin if cursor is at a block end." - (while (and (vera-re-search-backward - (concat "\\(" vera-end-block-re "\\)\\|" vera-beg-block-re) - nil t) - (match-string 1)) - (vera-corresponding-begin t)) - (unless recursive (vera-beginning-of-substatement))) - -(defun vera-corresponding-if () - "Find corresponding `if' if cursor is at `else'." - (while (and (vera-re-search-backward "}\\|\\<\\(if\\|else\\)\\>" nil t) - (not (equal (match-string 0) "if"))) - (if (equal (match-string 0) "else") - (vera-corresponding-if) - (forward-char) - (backward-sexp)))) - -(defun vera-beginning-of-statement () - "Go to beginning of current statement." - (let (pos) - (while - (progn - ;; search for end of previous statement - (while - (and (vera-re-search-backward - (concat "[);]\\|" vera-beg-block-re - "\\|" vera-end-block-re) nil t) - (equal (match-string 0) ")")) - (forward-char) - (backward-sexp)) - (setq pos (match-beginning 0)) - ;; go back to beginning of current statement - (goto-char (or (match-end 0) 0)) - (vera-forward-syntactic-ws nil t) - (when (looking-at "(") - (forward-sexp) - (vera-forward-syntactic-ws nil t)) - ;; if "else" found, go to "if" and search again - (when (looking-at "\\") - (vera-corresponding-if) - (setq pos (point)) - t)) - ;; if search is repeated, go to beginning of last search - (goto-char pos)))) - -(defun vera-beginning-of-substatement () - "Go to beginning of current substatement." - (let ((lim (point)) - pos) - ;; go to beginning of statement - (vera-beginning-of-statement) - (setq pos (point)) - ;; go forward all substatement opening statements until at LIM - (while (and (< (point) lim) - (vera-re-search-forward vera-beg-substatement-re lim t)) - (setq pos (match-beginning 0))) - (vera-forward-syntactic-ws nil t) - (when (looking-at "(") - (forward-sexp) - (vera-forward-syntactic-ws nil t)) - (when (< (point) lim) - (setq pos (point))) - (goto-char pos))) - -(defun vera-forward-statement () - "Move forward one statement." - (interactive) - (vera-prepare-search - (while (and (vera-re-search-forward - (concat "[(;]\\|" vera-beg-block-re "\\|" vera-end-block-re) - nil t) - (equal (match-string 0) "(")) - (backward-char) - (forward-sexp)) - (vera-beginning-of-substatement))) - -(defun vera-backward-statement () - "Move backward one statement." - (interactive) - (vera-prepare-search - (vera-backward-syntactic-ws nil t) - (unless (= (preceding-char) ?\)) - (backward-char)) - (vera-beginning-of-substatement))) - -(defun vera-forward-same-indent () - "Move forward to next line with same indent." - (interactive) - (let ((pos (point)) - (indent (current-indentation))) - (beginning-of-line 2) - (while (and (not (eobp)) - (or (looking-at "^\\s-*$") - (> (current-indentation) indent))) - (beginning-of-line 2)) - (if (= (current-indentation) indent) - (back-to-indentation) - (message "No following line with same indent found in this block") - (goto-char pos)))) - -(defun vera-backward-same-indent () - "Move backward to previous line with same indent." - (interactive) - (let ((pos (point)) - (indent (current-indentation))) - (beginning-of-line -0) - (while (and (not (bobp)) - (or (looking-at "^\\s-*$") - (> (current-indentation) indent))) - (beginning-of-line -0)) - (if (= (current-indentation) indent) - (back-to-indentation) - (message "No preceding line with same indent found in this block") - (goto-char pos)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; syntax analysis - -(defmacro vera-add-syntax (symbol &optional relpos) - "A simple macro to append the syntax in SYMBOL to the syntax list. -try to increase performance by using this macro." - `(setq syntax (cons (cons ,symbol ,(or relpos 0)) syntax))) - -(defun vera-guess-basic-syntax () - "Determine syntactic context of current line of code." - (save-excursion - (beginning-of-line) - (let ((indent-point (point)) - syntax state placeholder) - ;; determine syntax state - (setq state (parse-partial-sexp (point-min) (point))) - (cond - ;; CASE 1: in a comment? - ((nth 4 state) - ;; skip empty lines - (while (and (zerop (forward-line -1)) - (looking-at "^\\s-*$"))) - (vera-add-syntax 'comment (vera-point 'boi))) - ;; CASE 2: in a string? - ((nth 3 state) - (vera-add-syntax 'string)) - ;; CASE 3: at a directive? - ((save-excursion (back-to-indentation) (= (following-char) ?\#)) - (vera-add-syntax 'directive (point))) - ;; CASE 4: after an opening parenthesis (argument list continuation)? - ((and (nth 1 state) - (or (= (char-after (nth 1 state)) ?\() - ;; also for concatenation (opening '{' and ',' on eol/eopl) - (and (= (char-after (nth 1 state)) ?\{) - (or (save-excursion - (vera-backward-syntactic-ws) (= (char-before) ?,)) - (save-excursion - (end-of-line) (= (char-before) ?,)))))) - (goto-char (1+ (nth 1 state))) - ;; is there code after the opening parenthesis on the same line? - (if (looking-at "\\s-*$") - (vera-add-syntax 'arglist-cont (vera-point 'boi)) - (vera-add-syntax 'arglist-cont-nonempty (point)))) - ;; CASE 5: at a block closing? - ((save-excursion (back-to-indentation) (looking-at vera-end-block-re)) - ;; look for the corresponding begin - (vera-corresponding-begin) - (vera-add-syntax 'block-close (vera-point 'boi))) - ;; CASE 6: at a block intro (the first line after a block opening)? - ((and (save-excursion - (vera-backward-syntactic-ws nil t) - ;; previous line ends with a block opening? - (or (/= (skip-chars-backward "{") 0) (backward-word-strictly 1)) - (when (looking-at vera-beg-block-re) - ;; go to beginning of substatement - (vera-beginning-of-substatement) - (setq placeholder (point)))) - ;; not if "fork" is followed by "{" - (save-excursion - (not (and (progn (back-to-indentation) (looking-at "{")) - (progn (goto-char placeholder) - (looking-at "\\")))))) - (goto-char placeholder) - (vera-add-syntax 'block-intro (vera-point 'boi))) - ;; CASE 7: at the beginning of an else clause? - ((save-excursion (back-to-indentation) (looking-at "\\")) - ;; find corresponding if - (vera-corresponding-if) - (vera-add-syntax 'else-clause (vera-point 'boi))) - ;; CASE 8: at the beginning of a statement? - ;; is the previous command completed? - ((or (save-excursion - (vera-backward-syntactic-ws nil t) - (setq placeholder (point)) - ;; at the beginning of the buffer? - (or (bobp) - ;; previous line ends with a semicolon or - ;; is a block opening or closing? - (when (or (/= (skip-chars-backward "{};") 0) - (progn (back-to-indentation) - (looking-at (concat vera-beg-block-re "\\|" - vera-end-block-re)))) - ;; if at a block closing, go to beginning - (when (looking-at vera-end-block-re) - (vera-corresponding-begin)) - ;; go to beginning of the statement - (vera-beginning-of-statement) - (setq placeholder (point))) - ;; at a directive? - (when (progn (back-to-indentation) (looking-at "#")) - ;; go to previous statement - (vera-beginning-of-statement) - (setq placeholder (point))))) - ;; at a block opening? - (when (save-excursion (back-to-indentation) - (looking-at vera-beg-block-re)) - ;; go to beginning of the substatement - (vera-beginning-of-substatement) - (setq placeholder (point)))) - (goto-char placeholder) - (vera-add-syntax 'statement (vera-point 'boi))) - ;; CASE 9: at the beginning of a substatement? - ;; is this line preceded by a substatement opening statement? - ((save-excursion (vera-backward-syntactic-ws nil t) - (when (= (preceding-char) ?\)) (backward-sexp)) - (backward-word-strictly 1) - (setq placeholder (point)) - (looking-at vera-beg-substatement-re)) - (goto-char placeholder) - (vera-add-syntax 'substatement (vera-point 'boi))) - ;; CASE 10: it must be a statement continuation! - (t - ;; go to beginning of statement - (vera-beginning-of-substatement) - (vera-add-syntax 'statement-cont (vera-point 'boi)))) - ;; special case: look for a comment start - (goto-char indent-point) - (skip-chars-forward " \t") - (when (looking-at comment-start) - (vera-add-syntax 'comment-intro)) - ;; return syntax - syntax))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; indentation functions - -(defun vera-indent-line () - "Indent the current line as Vera code. -Return the amount of indentation change (in columns)." - (interactive) - (vera-prepare-search - (let* ((syntax (vera-guess-basic-syntax)) - (pos (- (point-max) (point))) - (indent (apply '+ (mapcar 'vera-get-offset syntax))) - (shift-amt (- (current-indentation) indent))) - (when vera-echo-syntactic-information-p - (message "syntax: %s, indent= %d" syntax indent)) - (unless (zerop shift-amt) - (beginning-of-line) - (delete-region (point) (vera-point 'boi)) - (indent-to indent)) - (if (< (point) (vera-point 'boi)) - (back-to-indentation) - ;; If initial point was within line's indentation, position after - ;; the indentation. Else stay at same point in text. - (when (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))) - shift-amt))) - -(defun vera-indent-buffer () - "Indent whole buffer as Vera code. -Calls `indent-region' for whole buffer." - (interactive) - (message "Indenting buffer...") - (indent-region (point-min) (point-max) nil) - (message "Indenting buffer...done")) - -(defun vera-indent-region (start end column) - "Indent region as Vera code." - (interactive "r\nP") - (message "Indenting region...") - (indent-region start end column) - (message "Indenting region...done")) - -(defsubst vera-indent-block-closing () - "If previous word is a block closing or `else', indent line again." - (when (= (char-syntax (preceding-char)) ?w) - (save-excursion - (backward-word-strictly 1) - (when (and (not (vera-in-literal)) - (looking-at (concat vera-end-block-re "\\|\\"))) - (indent-according-to-mode))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; electrifications - -(defvar hippie-expand-only-buffers) - -(defun vera-electric-tab (&optional prefix) - "Do what I mean (indent, expand, tab, change indent, etc..). -If preceding character is part of a word or a paren then `hippie-expand', -else if right of non whitespace on line then `tab-to-tab-stop', -else if last command was a tab or return then dedent one step or if a comment -toggle between normal indent and inline comment indent, -else indent `correctly'. -If `vera-intelligent-tab' is nil, always indent line." - (interactive "*P") - (if vera-intelligent-tab - (progn - (cond ((use-region-p) - (vera-indent-region (region-beginning) (region-end) nil)) - ((memq (char-syntax (preceding-char)) '(?w ?_)) - (let ((case-fold-search t) - (case-replace nil) - (hippie-expand-only-buffers - (or (and (boundp 'hippie-expand-only-buffers) - hippie-expand-only-buffers) - '(vera-mode)))) - (vera-expand-abbrev prefix))) - ((> (current-column) (current-indentation)) - (tab-to-tab-stop)) - ((and (or (eq last-command 'vera-electric-tab) - (eq last-command 'vera-electric-return)) - (/= 0 (current-indentation))) - (backward-delete-char-untabify vera-basic-offset nil)) - (t (indent-according-to-mode))) - (setq this-command 'vera-electric-tab)) - (indent-according-to-mode))) - -(defun vera-electric-return () - "Insert newline and indent. Indent current line if it is a block closing." - (interactive) - (vera-indent-block-closing) - (newline-and-indent)) - -(defun vera-electric-space (arg) - "Insert a space. Indent current line if it is a block closing." - (interactive "*P") - (unless arg - (vera-indent-block-closing)) - (self-insert-command (prefix-numeric-value arg))) - -(defun vera-electric-opening-brace (arg) - "Outdent opening brace." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (unless arg - (indent-according-to-mode))) - -(defun vera-electric-closing-brace (arg) - "Outdent closing brace." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (unless arg - (indent-according-to-mode))) - -(defun vera-electric-pound (arg) - "Insert `#' and indent as directive it first character of line." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (unless arg - (save-excursion - (backward-char) - (skip-chars-backward " \t") - (when (bolp) - (delete-horizontal-space))))) - -(defun vera-electric-star (arg) - "Insert a star character. Nicked from `c-electric-star'." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (if (and (not arg) - (memq (vera-in-literal) '(comment)) - (eq (char-before) ?*) - (save-excursion - (forward-char -1) - (skip-chars-backward "*") - (if (eq (char-before) ?/) - (forward-char -1)) - (skip-chars-backward " \t") - (bolp))) - (indent-according-to-mode))) - -(defun vera-electric-slash (arg) - "Insert a slash character. Nicked from `c-electric-slash'." - (interactive "*P") - (let* ((ch (char-before)) - (indentp (and (not arg) - (eq last-command-event ?/) - (or (and (eq ch ?/) - (not (vera-in-literal))) - (and (eq ch ?*) - (vera-in-literal)))))) - (self-insert-command (prefix-numeric-value arg)) - (when indentp - (indent-according-to-mode)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Hippie expand customization (for expansion of Vera commands) - -(defvar vera-abbrev-list - (append (list nil) vera-keywords - (list nil) vera-types - (list nil) vera-functions - (list nil) vera-constants - (list nil) vera-rvm-types - (list nil) vera-rvm-functions - (list nil) vera-rvm-constants) - "Predefined abbreviations for Vera.") - -(defvar vera-expand-upper-case nil) - -(eval-when-compile (require 'hippie-exp)) -(declare-function he-init-string "hippie-exp" (beg end)) -(declare-function he-dabbrev-beg "hippie-exp" ()) -(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) -(declare-function he-reset-string "hippie-exp" ()) -(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) - -(defun vera-try-expand-abbrev (old) - "Try expanding abbreviations from `vera-abbrev-list'." - (unless old - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (let ((abbrev-list vera-abbrev-list) - (sel-abbrev-list '())) - (while abbrev-list - (when (or (not (stringp (car abbrev-list))) - (string-match - (concat "^" he-search-string) (car abbrev-list))) - (setq sel-abbrev-list - (cons (car abbrev-list) sel-abbrev-list))) - (setq abbrev-list (cdr abbrev-list))) - (nreverse sel-abbrev-list)))) - (while (and he-expand-list - (or (not (stringp (car he-expand-list))) - (he-string-member (car he-expand-list) he-tried-table t))) - (unless (stringp (car he-expand-list)) - (setq vera-expand-upper-case (car he-expand-list))) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn (when old (he-reset-string)) - nil) - (he-substitute-string - (if vera-expand-upper-case - (upcase (car he-expand-list)) - (car he-expand-list)) - t) - (setq he-expand-list (cdr he-expand-list)) - t)) - -;; function for expanding abbrevs and dabbrevs -(defalias 'vera-expand-abbrev - (make-hippie-expand-function '(try-expand-dabbrev - try-expand-dabbrev-all-buffers - vera-try-expand-abbrev))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Comments - -(defun vera-comment-uncomment-region (beg end &optional _arg) - "Comment region if not commented, uncomment region if already commented." - (interactive "r\nP") - (goto-char beg) - (if (looking-at comment-start-skip) - (comment-region beg end '(4)) - (comment-region beg end))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Help functions - -(defun vera-customize () - "Call the customize function with `vera' as argument." - (interactive) - (customize-group 'vera)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Other - -;; remove ".vr" from `completion-ignored-extensions' -(setq completion-ignored-extensions - (delete ".vr" completion-ignored-extensions)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Bug reports -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vera-mode-help-address - "Reto Zimmermann , bug-gnu-emacs@gnu.org" - "Address for Vera Mode bug reports.") - -;; get reporter-submit-bug-report when byte-compiling -(eval-when-compile - (require 'reporter)) - -(defun vera-submit-bug-report () - "Submit via mail a bug report on Vera Mode." - (interactive) - ;; load in reporter - (and - (y-or-n-p "Do you want to submit a report on Vera Mode? ") - (require 'reporter) - (let ((reporter-prompt-for-summary-p t)) - (reporter-submit-bug-report - vera-mode-help-address - (concat "Vera Mode " vera-version) - (list - ;; report all important variables - 'vera-basic-offset - 'vera-underscore-is-part-of-word - 'vera-intelligent-tab - ) - nil nil - "Hi Reto,")))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vera-version () - "Echo the current version of Vera Mode in the minibuffer." - (interactive) - (message "Vera Mode %s (%s)" vera-version vera-time-stamp)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(provide 'vera-mode) - -;;; vera-mode.el ends here diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el deleted file mode 100644 index f88068c2714..00000000000 --- a/lisp/progmodes/vhdl-mode.el +++ /dev/null @@ -1,17992 +0,0 @@ -;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*- - -;; Copyright (C) 1992-2024 Free Software Foundation, Inc. - -;; Authors: Reto Zimmermann -;; Rodney J. Whitby -;; Maintainer: Reto Zimmermann -;; Keywords: languages vhdl -;; URL: https://iis-people.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html - -;; Yoni Rabkin contacted the maintainer of this -;; file on 18/3/2008, and the maintainer agreed that when a bug is -;; filed in the Emacs bug reporting system against this file, a copy -;; of the bug report be sent to the maintainer's email address. -;; -;; Reto also said in Apr 2021 that he preferred to keep the XEmacs -;; compatibility code. - -(defconst vhdl-version "3.38.5" - "VHDL Mode version number.") - -(defconst vhdl-time-stamp "2015-03-12" - "VHDL Mode time stamp for last update.") - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Commentary: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This package provides an Emacs major mode for editing VHDL code. -;; It includes the following features: - -;; - Syntax highlighting -;; - Indentation -;; - Template insertion (electrification) -;; - Insertion of file headers -;; - Insertion of user-specified models -;; - Port translation / testbench generation -;; - Structural composition -;; - Configuration generation -;; - Sensitivity list updating -;; - File browser -;; - Design hierarchy browser -;; - Source file compilation (syntax analysis) -;; - Makefile generation -;; - Code hiding -;; - Word/keyword completion -;; - Block commenting -;; - Code fixing/alignment/beautification -;; - PostScript printing -;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported -;; - Comprehensive menu -;; - Fully customizable -;; - Works under GNU Emacs (recommended) and XEmacs - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Documentation - -;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Emacs Versions - -;; this updated version was only tested on: GNU Emacs 24.1 - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Installation - -;; Prerequisites: GNU Emacs >= 21, 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': - -;; (push (expand-file-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: -;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET -;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el - -;; Add the following lines to the `site-start.el' file in the `site-lisp' -;; directory of your Emacs installation or to your Emacs start-up file `.emacs' -;; (not required in Emacs): - -;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) -;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) - -;; More detailed installation instructions are included in the official -;; VHDL Mode distribution. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Acknowledgments - -;; Electrification ideas by Bob Pack -;; and Steve Grout. - -;; Fontification approach suggested by Ken Wood . -;; Ideas about alignment from John Wiegley . - -;; Many thanks to all the users who sent me bug reports and enhancement -;; requests. -;; Thanks to Colin Marquardt for his serious beta testing, his innumerable -;; enhancement suggestions and the fruitful discussions. -;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. -;; Thanks to Ulf Klaperski for the indentation speedup hint. - -;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated -;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for -;; giving me the opportunity to develop this code. -;; This work has been funded in part by MICROSWISS, a Microelectronics Program -;; of the Swiss Government. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: - -(eval-when-compile - (condition-case nil (require 'cl-lib) (file-missing (require 'cl))) - (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew))) - -;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' -;; even for relatively simple cases such as used here. We only test <25 -;; because it's easier and sufficient. -(when (< emacs-major-version 25) - (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) - -;; Emacs 22+ handling -(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs >= 22, ... is used.") - -(defvar compilation-file-regexp-alist) -(defvar conf-alist) -(defvar conf-entry) -(defvar conf-key) -(defvar ent-alist) -(defvar itimer-version) -(defvar lazy-lock-defer-contextually) -(defvar lazy-lock-defer-on-scrolling) -(defvar lazy-lock-defer-on-the-fly) -(defvar speedbar-attached-frame) -(defvar arch-alist) -(defvar pack-alist) -(defvar file-alist) -(defvar unit-alist) -(defvar rule-alist) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; help function for user options -(defun vhdl-custom-set (variable value &rest functions) - "Set variables as in `custom-set-default' and call FUNCTIONS afterwards." - (if (fboundp 'custom-set-default) - (custom-set-default variable value) - (set-default variable value)) - (while functions - (when (fboundp (car functions)) (funcall (car functions))) - (setq functions (cdr functions)))) - -(defun vhdl-widget-directory-validate (widget) - "Check that the value of WIDGET is a valid directory entry (i.e. ends with -'/' or is empty)." - (let ((val (widget-value widget))) - (unless (string-match "^\\(\\|.*/\\)$" val) - (widget-put widget :error "Invalid directory entry: must end with `/'") - widget))) - -;; help string for user options -(defconst vhdl-name-doc-string " - -FROM REGEXP is a regular expression matching the original name: - \".*\" matches the entire string - \"\\(...\\)\" matches a substring -TO STRING specifies the string to be inserted as new name: - \"\\&\" means substitute entire matched text - \"\\N\" means substitute what matched the Nth \"\\(...\\)\" -Examples: - \".*\" \"\\&\" inserts original string - \".*\" \"\\&_i\" attaches \"_i\" to original string - \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string - \".*\" \"foo\" inserts constant string \"foo\" - \".*\" \"\" inserts empty string") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; User variables (customization options) - -(defgroup vhdl nil - "Customizations for VHDL Mode." - :prefix "vhdl-" - :group 'languages -; :version "21.2" ; comment out for XEmacs - ) - -(defgroup vhdl-mode nil - "Customizations for modes." - :group 'vhdl) - -(defcustom vhdl-indent-tabs-mode nil - "Non-nil means indentation can insert tabs. -Overrides local variable `indent-tabs-mode'." - :type 'boolean - :group 'vhdl-mode) - - -(defgroup vhdl-compile nil - "Customizations for compilation." - :group 'vhdl) - -(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]+\\):\\s-+" nil 1 nil nil) ("^Compiling file \\(.+\\)" 1) - ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" - "PACK/\\1.vif" "BODY/\\1.vif" upcase)) - ;; Aldec - ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 - ("Aldec" "vcom" "-work \\1" "make" "-f \\1" - nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" - ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3 nil) ("" 0) - nil) - ;; Cadence Leapfrog: cv -file test.vhd - ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared - ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" - ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil nil) ("" 0) - ("\\1/entity" "\\2/\\1" "\\1/configuration" - "\\1/package" "\\1/body" downcase)) - ;; Cadence Affirma NC vhdl: ncvhdl test.vhd - ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier - ;; (PLL_400X_TOP) is not declared [10.3]. - ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" - ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3 nil) ("" 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 -a bad_counter.vhdl - ;; bad_counter.vhdl:13:14: operator "=" is overloaded - ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" - ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3 nil) ("" 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 nil) (" " 0) - nil) - ;; Ikos Voyager: analyze test.vhd - ;; analyze test.vhd - ;; E L4/C5: this library unit is inaccessible - ("Ikos" "analyze" "-l \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "ikos" - ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2 nil) - ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) - nil) - ;; ModelSim, Model Technology: vcom test.vhd - ;; ERROR: test.vhd(14): Unknown identifier: positiv - ;; WARNING[2]: test.vhd(85): Possible infinite loop - ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ... - ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb - ;; ** Error: counter_rtl.vhd(18): Nonresolved signal 'hallo' has multiple sources. - ;; Drivers: - ;; counter_rtl.vhd(27):Conditional signal assignment line__27 - ;; counter_rtl.vhd(29):Conditional signal assignment line__29 - ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" - nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" - ("^\\(?:\\(?1:ERROR\\|\\*\\* Error\\)\\|\\(?2:WARNING\\|\\*\\* Warning\\)\\|\\(?3:NOTE\\|\\*\\* Note\\)\\)[^:]*:\\( *\\[[0-9]+]\\| ([^)]+)\\)? \\(?4:[^ \t\n]+\\)(\\(?5:[0-9]+\\)):" 4 5 nil (2 . 3)) - ("" 0) - ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" - "\\1/_primary.dat" "\\1/body.dat" downcase)) - ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd - ;; test.vhd:34: error message - ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" - ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil 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 nil) ("" 0) - nil) - ;; QuickHDL, Mentor Graphics: qvhcom test.vhd - ;; ERROR: test.vhd(24): near "dnd": expecting: END - ;; WARNING[4]: test.vhd(30): A space is required between ... - ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" - ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil nil) ("" 0) - ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" - "\\1/_primary.dat" "\\1/body.dat" downcase)) - ;; Savant: scram -publish-cc test.vhd - ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for - ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" - ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil 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)) - ;; Simili: vhdlp -work test.vhd - ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix - ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "simili" - ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil nil) ("" 0) - ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" - "\\1/prim.var" "\\1/_body.var" downcase)) - ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd - ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier - ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" - ("^ *ERROR\\[[0-9]+]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil nil) ("" 0) - nil) - ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd - ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. - ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" - ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil nil) ("" 0) - ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) - ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd - ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. - ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" - ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil nil) ("" 0) - ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) - ;; Synplify: - ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 - ("Synplify" "n/a" "n/a" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "synplify" - ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3 nil) ("" 0) - nil) - ;; Vantage: analyze -libfile vsslib.ini -src test.vhd - ;; Compiling "test.vhd" line 1... - ;; **Error: LINE 49 *** No aggregate value is valid in this context. - ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "vantage" - ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil nil) - ("^ *Compiling \"\\(.+\\)\" " 1) - nil) - ;; VeriBest: vc vhdl test.vhd - ;; (no file name printed out!) - ;; 32: Z <= A and BitA ; - ;; ^^^^ - ;; [Error] Name BITA is unknown - ("VeriBest" "vc" "vhdl" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "veribest" - ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil 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]+\\) \\*\\*\\*" nil 1 nil nil) - ("^ *Compiling \"\\(.+\\)\" " 1) - nil) - ;; Xilinx XST: - ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error - ("Xilinx XST" "xflow" "" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" - ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil nil) ("" 0) - nil) - ;; Xilinx Vivado: - ;; ERROR: [VRFC 10-1412] syntax error near o_idle [test.vhd:23] - ("Xilinx Vivado" "xvhdl" "" "make" "-f \\1" - nil "mkdir \\1" "./" "work/" "Makefile" "vivado" - ("^\\(?:\\(?1:ERROR\\)\\|\\(?2:WARNING\\)\\|\\(?3:INFO\\)\\): \\(.+\\) \\[\\(?4:[^ \t\n]+\\):\\(?5:[0-9]+\\)\\]" 4 5 nil (2 . 3)) ("" 0) - ("\\1/entity" "\\2/\\1" "\\1/configuration" - "\\1/package" "\\1/body" downcase)) - ) - "List of available VHDL compilers and their properties. -Each list entry specifies the following items for a compiler: -Compiler: - Compiler name : name used in option `vhdl-compiler' to choose compiler - Compile command : command used for source file compilation - Compile options : compile options (\"\\1\" inserts library name) - Make command : command used for compilation using a Makefile - Make options : make options (\"\\1\" inserts Makefile name) - Generate Makefile: use built-in function or command to generate a Makefile - (\"\\1\" inserts Makefile name, \"\\2\" inserts library name) - Library command : command to create library directory (\"\\1\" inserts - library directory, \"\\2\" inserts library name) - Compile directory: where compilation is run and the Makefile is placed - Library directory: directory of default library - Makefile name : name of Makefile (default is \"Makefile\") - ID string : compiler identification string (see `vhdl-project-alist') -Error message: - Regexp : regular expression to match error messages (*) - File subexp index: index of subexpression that matches the file name - Line subexp index: index of subexpression that matches the line number - Column subexp idx: index of subexpression that matches the column number - Type subexp : message type, can be nil for a real error, 1 for warning - or 0 for info. Type can also be detected using the form - (WARNING . INFO). In that case this will be equivalent to - 1 if the WARNING’th subexpression matched or else - equivalent to 0 if the INFO’th subexpression matched, or - else equivalent to nil if neither of them matched. See - also `compilation-error-regexp-alist'. -File message: - Regexp : regular expression to match a file name message - File subexp index: index of subexpression that matches the file name -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, - \"\\3\" inserts the library name) - Case adjustment : adjust case of inserted unit names - -\(*) The regular expression must match the error message starting from the - beginning of the line (but not necessarily to the end of the line). - -Compile options allows insertion of the library name (see `vhdl-project-alist') -in order to set the compilers library option (e.g. \"vcom -work my_lib\"). - -For Makefile generation, the built-in function can be used (requires -specification of the unit-to-file name mapping). Alternatively, an -external command can be specified. Work directory allows specification of -an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\", -used for Makefile generation). To use another library name than \"work\", -customize `vhdl-project-alist'. The library command is inserted in Makefiles -to automatically create the library directory if not existent. - -Compile options, compile directory, library directory, and Makefile name are -overwritten by the project settings if a project is defined (see -`vhdl-project-alist'). Directory paths are relative to the source file -directory. - -Some compilers do not include the file name in the error message, but print -out a file name message in advance. In this case, set \"File Subexp Index\" -under \"Error Message\" to 0 and fill out the \"File Message\" entries. -If no file name at all is printed out, set both \"File Message\" entries to 0 -\(a default file name message will be printed out instead, does not work in -XEmacs). - -A compiler is selected for syntax analysis (\\[vhdl-compile]) by -assigning its name to option `vhdl-compiler'. - -Please send any missing or erroneous compiler properties to the maintainer for -updating. - -NOTE: Activate new error and file message regexps and reflect the new setting - in the choice list of option `vhdl-compiler' by restarting Emacs." - :type '(repeat - (list :tag "Compiler" :indent 2 - (string :tag "Compiler name ") - (string :tag "Compile command ") - (string :tag "Compile options " "-work \\1") - (string :tag "Make command " "make") - (string :tag "Make options " "-f \\1") - (choice :tag "Generate Makefile " - (const :tag "Built-in function" nil) - (string :tag "Command" "vmake \\2 > \\1")) - (string :tag "Library command " "mkdir \\1") - (directory :tag "Compile directory " - :validate vhdl-widget-directory-validate "./") - (directory :tag "Library directory " - :validate vhdl-widget-directory-validate "work/") - (file :tag "Makefile name " "Makefile") - (string :tag "ID string ") - (list :tag "Error message" :indent 4 - (regexp :tag "Regexp ") - (choice :tag "File subexp " - (integer :tag "Index") - (const :tag "No file name" nil)) - (integer :tag "Line subexp index") - (choice :tag "Column subexp " - (integer :tag "Index") - (const :tag "No column number" nil)) - (choice :tag "Type " - (const :tag "Info" 0) - (const :tag "Warning" 1) - (const :tag "Error" nil) - (cons :tag "Type detection" - (natnum :tag "Warning subexp index") - (natnum :tag "Info subexp index ")))) - (list :tag "File message" :indent 4 - (regexp :tag "Regexp ") - (integer :tag "File subexp index")) - (choice :tag "Unit-to-file name mapping" - :format "%t: %[Value Menu%] %v\n" - (const :tag "Not defined" nil) - (list :tag "To string" :indent 4 - (string :tag "Entity " "\\1.vhd") - (string :tag "Architecture " "\\2_\\1.vhd") - (string :tag "Configuration " "\\1.vhd") - (string :tag "Package " "\\1.vhd") - (string :tag "Package Body " "\\1_body.vhd") - (choice :tag "Case adjustment " - (const :tag "None" identity) - (const :tag "Upcase" upcase) - (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" - "Specifies the VHDL compiler to be used for syntax analysis. -Select a compiler name from the ones defined in option `vhdl-compiler-alist'." - :type (let ((alist vhdl-compiler-alist) list) - (while alist - (push (list 'const (caar alist)) list) - (setq alist (cdr alist))) - (append '(choice) (nreverse list))) - :group 'vhdl-compile) - -(defcustom vhdl-compile-use-local-error-regexp nil - "Non-nil means use buffer-local `compilation-error-regexp-alist'. -In this case, only error message regexps for VHDL compilers are active if -compilation is started from a VHDL buffer. Otherwise, the error message -regexps are appended to the predefined global regexps, and all regexps are -active all the time. Note that by doing that, the predefined global regexps -might result in erroneous parsing of error messages for some VHDL compilers. - -NOTE: Activate the new setting by restarting Emacs." - :version "25.1" ; t -> nil - :type 'boolean - :group 'vhdl-compile) - -(defcustom vhdl-makefile-default-targets '("all" "clean" "library") - "List of default target names in Makefiles. -Automatically generated Makefiles include three default targets to compile -the entire design, clean the entire design and to create the design library. -This option allows you to change the names of these targets to avoid conflicts -with other user Makefiles." - :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 - "Functions to run at the end of Makefile generation. -Allows you to insert user specific parts into a Makefile. - -Example: - (lambda nil - (re-search-backward \"^# Rule for compiling entire design\") - (insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))" - :type 'hook - :group 'vhdl-compile) - -(defcustom vhdl-default-library "work" - "Name of default library. -Is overwritten by project settings if a project is active." - :type 'string - :group 'vhdl-compile) - - -(defgroup vhdl-project nil - "Customizations for projects." - :group 'vhdl) - -(defcustom vhdl-project-alist - '(("Example 1" "Source files in two directories, custom library name, VHDL'87" - "~/example1/" ("src/system/" "src/components/") "" - (("ModelSim" "-87 \\2" "-f \\1 top_level" nil) - ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) - "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "") - ("Example 2" "Individual source files, multiple compilers in different directories" - "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") "" - nil "\\1/" "work" "\\1/work/" "Makefile" "") - ("Example 3" "Source files in a directory tree, multiple compilers in same directory" - "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/" - nil "./" "work" "work-\\1/" "Makefile-\\1" "\ -------------------------------------------------------------------------------- --- This is a multi-line project description --- that can be used as a project dependent part of the file header. -")) - "List of projects and their properties. - Name : name used in option `vhdl-project' to choose project - Title : title of project (single-line string) - Default directory: default project directory (absolute path) - Sources : a) source files : path + \"/\" + file name - b) directory : path + \"/\" - c) directory tree: \"-r \" + path + \"/\" - Exclude regexp : matches file/directory names to be excluded as sources - Compile options : project-specific options for each compiler - Compiler name : name of compiler for which these options are valid - Compile options: project-specific compiler options - (\"\\1\" inserts library name, \"\\2\" default options) - Make options: project-specific make options - (\"\\1\" inserts Makefile name, \"\\2\" default options) - Exceptions : file-specific exceptions - File name regexp: matches file names for which exceptions are valid - - Options : file-specific compiler options string - (\"\\1\" inserts library name, \"\\2\" default options, - \"\\3\" project-specific options) - - Do not compile: do not compile this file (in Makefile) - Compile directory: where compilation is run and the Makefile is placed - (\"\\1\" inserts compiler ID string) - Library name : name of library (default is \"work\") - Library directory: path to library (\"\\1\" inserts compiler ID string) - Makefile name : name of Makefile - (\"\\1\" inserts compiler ID string, \"\\2\" library name) - Description : description of project (multi-line string) - -Project title and description are used to insert into the file header (see -option `vhdl-file-header'). - -The default directory must have an absolute path (use `M-TAB' for completion). -All other paths can be absolute or relative to the default directory. All -paths must end with `/'. - -The design units found in the sources (files and directories) are shown in the -hierarchy browser. Path and file name can contain wildcards `*' and `?' as -well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute. -Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are -specified, the default directory is taken as source directory. Otherwise, -the default directory is only taken as source directory if there is a sources -entry with the empty string or \"./\". Exclude regexp allows you to filter -out specific file and directory names from the list of sources (e.g. CVS -directories). - -Files are compiled in the compile directory. Makefiles are also placed into -the compile directory. Library directory specifies which directory the -compiler compiles into (used to generate the Makefile). - -Since different compile/library directories and Makefiles may exist for -different compilers within one project, these paths and names allow the -insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist'). -Compile options, compile directory, library directory, and Makefile name -overwrite the settings of the current compiler. - -File-specific compiler options (highest priority) overwrite project-specific -options which overwrite default options (lowest priority). Lower priority -options can be inserted in higher priority options. This allows you to reuse -default options (e.g. \"-file\") in project- or file-specific options (e.g. -\"-93 -file\"). - -NOTE: Reflect the new setting in the choice list of option `vhdl-project' - by restarting Emacs." - :type `(repeat - (list :tag "Project" :indent 2 - (string :tag "Name ") - (string :tag "Title ") - (directory :tag "Default directory" - :validate vhdl-widget-directory-validate - ,(abbreviate-file-name default-directory)) - (repeat :tag "Sources " :indent 4 - (directory :format " %v" "./")) - (regexp :tag "Exclude regexp ") - (repeat - :tag "Compile options " :indent 4 - (list :tag "Compiler" :indent 6 - ,(let ((alist vhdl-compiler-alist) list) - (while alist - (push (list 'const (caar alist)) list) - (setq alist (cdr alist))) - (append '(choice :tag "Compiler name") - (nreverse list))) - (string :tag "Compile options" "\\2") - (string :tag "Make options " "\\2") - (repeat - :tag "Exceptions " :indent 8 - (cons :format "%v" - (regexp :tag "File name regexp ") - (choice :format "%[Value Menu%] %v" - (string :tag "Options" "\\3") - (const :tag "Do not compile" nil)))))) - (directory :tag "Compile directory" - :validate vhdl-widget-directory-validate "./") - (string :tag "Library name " "work") - (directory :tag "Library directory" - :validate vhdl-widget-directory-validate "work/") - (file :tag "Makefile name " "Makefile") - (string :tag "Description: (type `C-j' for newline)" - :format "%t\n%v\n"))) - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-update-mode-menu - #'vhdl-speedbar-refresh)) - :group 'vhdl-project) - -(defcustom vhdl-project nil - "Specifies the default for the current project. -Select a project name from the ones defined in option `vhdl-project-alist'. -Is used to determine the project title and description to be inserted in file -headers and the source files/directories to be scanned in the hierarchy -browser. The current project can also be changed temporarily in the menu." - :type (let ((alist vhdl-project-alist) list) - (while alist - (push (list 'const (caar alist)) list) - (setq alist (cdr alist))) - (append '(choice (const :tag "None" nil) (const :tag "--")) - (nreverse list))) - :group 'vhdl-project) - -(defcustom vhdl-project-file-name '("\\1.prj") - "List of file names/paths for importing/exporting project setups. -\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is -replaced by the user name (allows you to have user-specific project setups). -The first entry is used as file name to import/export individual project -setups. All entries are used to automatically import project setups at -startup (see option `vhdl-project-autoload'). Projects loaded from the -first entry are automatically made current. Hint: specify local project -setups in first entry, global setups in following entries; loading a local -project setup will make it current, while loading the global setups -is done without changing the current project. -Names can also have an absolute path (i.e. project setups can be stored -in global directories)." - :type '(repeat (string :tag "File name" "\\1.prj")) - :group 'vhdl-project) - - -(define-obsolete-variable-alias 'vhdl-project-auto-load - 'vhdl-project-autoload "27.1") - -(defcustom vhdl-project-autoload '(startup) - "Automatically load project setups from files. -All project setup files that match the file names specified in option -`vhdl-project-file-name' are automatically loaded. The project of the -\(alphabetically) last loaded setup of the first `vhdl-project-file-name' -entry is activated. -A project setup file can be obtained by exporting a project (see menu). - At startup: project setup file is loaded at Emacs startup." - :type '(set (const :tag "At startup" startup)) - :group 'vhdl-project) - -(defcustom vhdl-project-sort t - "Non-nil means projects are displayed in alphabetical order." - :type 'boolean - :group 'vhdl-project) - - -(defgroup vhdl-style nil - "Customizations for coding styles." - :group 'vhdl - :group 'vhdl-template - :group 'vhdl-port - :group 'vhdl-compose) - -(defcustom vhdl-standard '(93 nil) - "VHDL standards used. -Basic standard: - VHDL'87 : IEEE Std 1076-1987 - VHDL'93/02 : IEEE Std 1076-1993/2002 - VHDL'08 : IEEE Std 1076-2008 -Additional standards: - VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal) - Math packages: IEEE Std 1076.2 (`math_real', `math_complex') - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type '(list (choice :tag "Basic standard" - (const :tag "VHDL'87" 87) - (const :tag "VHDL'93/02" 93) - (const :tag "VHDL'08" 08)) - (set :tag "Additional standards" :indent 2 - (const :tag "VHDL-AMS" ams) - (const :tag "Math packages" math))) - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-template-map-init - #'vhdl-mode-abbrev-table-init - #'vhdl-template-construct-alist-init - #'vhdl-template-package-alist-init - #'vhdl-update-mode-menu - #'vhdl-words-init 'vhdl-font-lock-init)) - :group 'vhdl-style) - -(defcustom vhdl-basic-offset 2 - "Amount of basic offset used for indentation. -This value is used by + and - symbols in `vhdl-offsets-alist'." - :type 'integer - :group 'vhdl-style) - -(defcustom vhdl-upper-case-keywords nil - "Non-nil means convert keywords to upper case. -This is done when typed or expanded or by the fix case functions." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) - :group 'vhdl-style) - -(defcustom vhdl-upper-case-types nil - "Non-nil means convert standardized types to upper case. -This is done when expanded or by the fix case functions." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) - :group 'vhdl-style) - -(defcustom vhdl-upper-case-attributes nil - "Non-nil means convert standardized attributes to upper case. -This is done when expanded or by the fix case functions." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) - :group 'vhdl-style) - -(defcustom vhdl-upper-case-enum-values nil - "Non-nil means convert standardized enumeration values to upper case. -This is done when expanded or by the fix case functions." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) - :group 'vhdl-style) - -(defcustom vhdl-upper-case-constants t - "Non-nil means convert standardized constants to upper case. -This is done when expanded." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) - :group 'vhdl-style) - -(defcustom vhdl-use-direct-instantiation 'standard - "Non-nil means use VHDL'93 direct component instantiation. - Never : never - Standard: only in VHDL standards that allow it (VHDL'93 and higher) - Always : always" - :type '(choice (const :tag "Never" never) - (const :tag "Standard" standard) - (const :tag "Always" always)) - :group 'vhdl-style) - -(defcustom vhdl-array-index-record-field-in-sensitivity-list t - "Non-nil means include array indices / record fields in sensitivity list. -If a signal read in a process is a record field or pointed to by an array -index, the record field or array index is included with the record name in -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 naming conventions." - :group 'vhdl) - -(defcustom vhdl-entity-file-name '(".*" . "\\&") - (concat - "Specifies how the entity file name is obtained. -The entity file name can be obtained by modifying the entity name (e.g. -attaching or stripping off a substring). The file extension is automatically -taken from the file name of the current buffer." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-naming - :group 'vhdl-compose) - -(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2") - (concat - "Specifies how the architecture file name is obtained. -The architecture file name can be obtained by modifying the entity -and/or architecture name (e.g. attaching or stripping off a substring). The -file extension is automatically taken from the file name of the current -buffer. The string that is matched against the regexp is the concatenation -of the entity and the architecture name separated by a space. This gives -access to both names (see default setting as example)." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-naming - :group 'vhdl-compose) - -(defcustom vhdl-configuration-file-name '(".*" . "\\&") - (concat - "Specifies how the configuration file name is obtained. -The configuration file name can be obtained by modifying the configuration -name (e.g. attaching or stripping off a substring). The file extension is -automatically taken from the file name of the current buffer." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-naming - :group 'vhdl-compose) - -(defcustom vhdl-package-file-name '(".*" . "\\&") - (concat - "Specifies how the package file name is obtained. -The package file name can be obtained by modifying the package name (e.g. -attaching or stripping off a substring). The file extension is automatically -taken from the file name of the current buffer. Package files can be created -in a different directory by prepending a relative or absolute path to the -file name." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-naming - :group 'vhdl-compose) - -(defcustom vhdl-file-name-case 'identity - "Specifies how to change case for obtaining file names. -When deriving a file name from a VHDL unit name, case can be changed as -follows: - As Is: case is not changed (taken as is) - Lower Case: whole name is changed to lower case - Upper Case: whole name is changed to upper case - Capitalize: first letter of each word in name is capitalized" - :type '(choice (const :tag "As Is" identity) - (const :tag "Lower Case" downcase) - (const :tag "Upper Case" upcase) - (const :tag "Capitalize" capitalize)) - :group 'vhdl-naming - :group 'vhdl-compose) - - -(defgroup vhdl-template nil - "Customizations for electrification." - :group 'vhdl) - -(defcustom vhdl-electric-keywords '(vhdl user) - "Type of keywords for which electrification is enabled. - VHDL keywords: invoke built-in templates - User keywords: invoke user models (see option `vhdl-model-alist')" - :type '(set (const :tag "VHDL keywords" vhdl) - (const :tag "User model keywords" user)) - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init)) - :group 'vhdl-template) - -(defcustom vhdl-optional-labels 'process - "Constructs for which labels are to be queried. -Template generators prompt for optional labels for: - None : no constructs - Processes only: processes only (also procedurals in VHDL-AMS) - All constructs: all constructs with optional labels and keyword END" - :type '(choice (const :tag "None" none) - (const :tag "Processes only" process) - (const :tag "All constructs" all)) - :group 'vhdl-template) - -(defcustom vhdl-insert-empty-lines 'unit - "Specifies whether to insert empty lines in some templates. -This improves readability of code. Empty lines are inserted in: - None : no constructs - Design units only: entities, architectures, configurations, packages only - All constructs : also all constructs with BEGIN...END parts - -Replaces option `vhdl-additional-empty-lines'." - :type '(choice (const :tag "None" none) - (const :tag "Design units only" unit) - (const :tag "All constructs" all)) - :group 'vhdl-template - :group 'vhdl-port - :group 'vhdl-compose) - -(defcustom vhdl-argument-list-indent nil - "Non-nil means indent argument lists relative to opening parenthesis. -That is, argument, association, and port lists start on the same line as the -opening parenthesis and subsequent lines are indented accordingly. -Otherwise, lists start on a new line and are indented as normal code." - :type 'boolean - :group 'vhdl-template - :group 'vhdl-port - :group 'vhdl-compose) - -(defcustom vhdl-association-list-with-formals t - "Non-nil means write association lists with formal parameters. -Templates prompt for formal and actual parameters (ports/generics). -When pasting component instantiations, formals are included. -If nil, only a list of actual parameters is entered." - :type 'boolean - :group 'vhdl-template - :group 'vhdl-port - :group 'vhdl-compose) - -(defcustom vhdl-conditions-in-parenthesis nil - "Non-nil means place parenthesis around condition expressions." - :type 'boolean - :group 'vhdl-template) - -(defcustom vhdl-sensitivity-list-all t - "Non-nil means use `all' keyword in sensitivity list." - :version "25.1" - :type 'boolean - :group 'vhdl-template) - -(defcustom vhdl-zero-string "'0'" - "String to use for a logic zero." - :type 'string - :group 'vhdl-template) - -(defcustom vhdl-one-string "'1'" - "String to use for a logic one." - :type 'string - :group 'vhdl-template) - - -(defgroup vhdl-header nil - "Customizations for file header." - :group 'vhdl-template - :group 'vhdl-compose) - -(defcustom vhdl-file-header "\ -------------------------------------------------------------------------------- --- Title : --- Project : <project> -------------------------------------------------------------------------------- --- File : <filename> --- Author : <author> --- Company : <company> --- Created : <date> --- Last update: <date> --- Platform : <platform> --- Standard : <standard> -<projectdesc>------------------------------------------------------------------------------- --- Description: <cursor> -<copyright>------------------------------------------------------------------------------- --- Revisions : --- Date Version Author Description --- <date> 1.0 <login>\tCreated -------------------------------------------------------------------------------- - -" - "String or file to insert as file header. -If the string specifies an existing file name, the contents of the file is -inserted, otherwise the string itself is inserted as file header. -Type `C-j' for newlines. -If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> -if the header needs to be version controlled. - -The following keywords for template generation are supported: - <filename> : replaced by the name of the buffer - <author> : replaced by the user name and email address - (`user-full-name', `user-mail-address') - <authorfull> : replaced by the user full name (`user-full-name') - <login> : replaced by user login name (`user-login-name') - <company> : replaced by contents of option `vhdl-company-name' - <date> : replaced by the current date - <year> : replaced by the current year - <project> : replaced by title of current project (`vhdl-project') - <projectdesc> : replaced by description of current project (`vhdl-project') - <copyright> : replaced by copyright string (`vhdl-copyright-string') - <platform> : replaced by contents of option `vhdl-platform-spec' - <standard> : replaced by the VHDL language standard(s) used - <... string> : replaced by a queried string (\"...\" is the prompt word) - <title string>: replaced by file title in automatically generated files - <cursor> : final cursor position - -The (multi-line) project description <projectdesc> can be used as a project -dependent part of the file header and can also contain the above keywords." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-file-footer "" - "String or file to insert as file footer. -If the string specifies an existing file name, the contents of the file is -inserted, otherwise the string itself is inserted as file footer (i.e. at -the end of the file). -Type `C-j' for newlines. -The same keywords as in option `vhdl-file-header' can be used." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-company-name "" - "Name of company to insert in file header. -See option `vhdl-file-header'." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-copyright-string "\ -------------------------------------------------------------------------------- --- Copyright (c) <year> <company> -" - "Copyright string to insert in file header. -Can be multi-line string (type `C-j' for newline) and contain other file -header keywords (see option `vhdl-file-header')." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-platform-spec "" - "Specification of VHDL platform to insert in file header. -The platform specification should contain names and versions of the -simulation and synthesis tools used. -See option `vhdl-file-header'." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-date-format "%Y-%m-%d" - "Specifies the date format to use in the header. -This string is passed as argument to the command `format-time-string'. -For more information on format strings, see the documentation for the -`format-time-string' command (C-h f `format-time-string')." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-modify-date-prefix-string "-- Last update: " - "Prefix string of modification date in VHDL file header. -If actualization of the modification date is called (menu, -\\[vhdl-template-modify]), this string is searched and the rest -of the line replaced by the current date." - :type 'string - :group 'vhdl-header) - -(defcustom vhdl-modify-date-on-saving t - "Non-nil means update the modification date when the buffer is saved. -Calls function \\[vhdl-template-modify]). - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type 'boolean - :group 'vhdl-header) - - -(defgroup vhdl-sequential-process nil - "Customizations for sequential processes." - :group 'vhdl-template) - -(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 "Asynchronous" async) - (const :tag "Query" query)) - :group 'vhdl-sequential-process) - -(defcustom vhdl-reset-active-high nil - "Non-nil means reset in sequential processes is active high. -Otherwise, reset is active low." - :type 'boolean - :group 'vhdl-sequential-process) - -(defcustom vhdl-clock-rising-edge t - "Non-nil means rising edge of clock triggers sequential processes. -Otherwise, falling edge triggers." - :type 'boolean - :group 'vhdl-sequential-process) - -(defcustom vhdl-clock-edge-condition 'standard - "Syntax of the clock edge condition. - Standard: \"clk\\='event and clk = \\='1\\='\" - Function: \"rising_edge(clk)\"" - :type '(choice (const :tag "Standard" standard) - (const :tag "Function" function)) - :group 'vhdl-sequential-process) - -(defcustom vhdl-clock-name "" - "Name of clock signal to use in templates." - :type 'string - :group 'vhdl-sequential-process) - -(defcustom vhdl-reset-name "" - "Name of reset signal to use in templates." - :type 'string - :group 'vhdl-sequential-process) - - -(defgroup vhdl-model nil - "Customizations for user models." - :group 'vhdl) - -(defcustom vhdl-model-alist - '(("Example Model" - "<label> : process (<clock>, <reset>) -begin -- process <label> - if <reset> = '0' then -- asynchronous reset (active low) - <cursor> - elsif <clock>'event and <clock> = '1' then -- rising clock edge - if <enable> = '1' then -- synchronous load - - end if; - end if; -end process <label>;" - "e" "")) - "List of user models. -VHDL models (templates) can be specified by the user in this list. They can be -invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword -electrification (i.e. overriding existing or creating new keywords, see -option `vhdl-electric-keywords'). - Name : name of model (string of words and spaces) - String : string or name of file to be inserted as model (newline: `C-j') - Key Binding: key binding to invoke model, added to prefix `C-c C-m' - (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\") - Keyword : keyword to invoke model - -The models can contain prompts to be queried. A prompt is of the form \"<...>\". -A prompt that appears several times is queried once and replaced throughout -the model. Special prompts are: - <clock> : name specified in `vhdl-clock-name' (if not empty) - <reset> : name specified in `vhdl-reset-name' (if not empty) - <cursor>: final cursor position -File header prompts (see variable `vhdl-file-header') are automatically -replaced, so that user models can also be used to insert different types of -headers. - -If the string specifies an existing file name, the contents of the file is -inserted, otherwise the string itself is inserted. -The code within the models should be correctly indented. -Type `C-j' for newlines. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type '(repeat (list :tag "Model" :indent 2 - (string :tag "Name ") - (string :tag "String : (type `C-j' for newline)" - :format "%t\n%v") - (sexp :tag "Key binding" x) - (string :tag "Keyword " :format "%t: %v\n"))) - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-model-map-init - #'vhdl-model-defun - #'vhdl-mode-abbrev-table-init - #'vhdl-update-mode-menu)) - :group 'vhdl-model) - - -(defgroup vhdl-compose nil - "Customizations for structural composition." - :group 'vhdl) - -(defcustom vhdl-compose-architecture-name '(".*" . "str") - (concat - "Specifies how the component architecture name is obtained. -The component architecture name can be obtained by modifying the entity name -\(e.g. attaching or stripping off a substring). -If TO STRING is empty, the architecture name is queried." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-compose) - -(defcustom vhdl-compose-configuration-name - '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg") - (concat - "Specifies how the configuration name is obtained. -The configuration name can be obtained by modifying the entity and/or -architecture name (e.g. attaching or stripping off a substring). The string -that is matched against the regexp is the concatenation of the entity and the -architecture name separated by a space. This gives access to both names (see -default setting as example)." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-compose) - -(defcustom vhdl-components-package-name - '((".*" . "\\&_components") . "components") - (concat - "Specifies how the name for the components package is obtained. -The components package is a package containing all component declarations for -the current design. Its name can be obtained by modifying the project name -\(e.g. attaching or stripping off a substring). If no project is defined, the -DIRECTORY entry is chosen." - vhdl-name-doc-string) - :type '(cons (cons :tag "Project" :indent 2 - (regexp :tag "From regexp") - (string :tag "To string ")) - (string :tag "Directory:\n String ")) - :group 'vhdl-compose) - -(defcustom vhdl-use-components-package nil - "Non-nil means use a separate components package for component declarations. -Otherwise, component declarations are inserted and searched for in the -architecture declarative parts." - :type 'boolean - :group 'vhdl-compose) - -(defcustom vhdl-compose-include-header t - "Non-nil means include a header in automatically generated files." - :type 'boolean - :group 'vhdl-compose) - -(defcustom vhdl-compose-create-files 'single - "Specifies whether new files should be created for the new component. -The component's entity and architecture are inserted: - None : in current buffer - Single file : in new single file - Separate files: in two separate files -The file names are obtained from variables `vhdl-entity-file-name' and -`vhdl-architecture-file-name'." - :type '(choice (const :tag "None" none) - (const :tag "Single file" single) - (const :tag "Separate files" separate)) - :group 'vhdl-compose) - -(defcustom vhdl-compose-configuration-create-file nil - "Specifies whether a new file should be created for the configuration. -If non-nil, a new file is created for the configuration. -The file name is obtained from variable `vhdl-configuration-file-name'." - :type 'boolean - :group 'vhdl-compose) - -(defcustom vhdl-compose-configuration-hierarchical t - "Specifies whether hierarchical configurations should be created. -If non-nil, automatically created configurations are hierarchical and include -the whole hierarchy of subcomponents. Otherwise the configuration only -includes one level of subcomponents." - :type 'boolean - :group 'vhdl-compose) - -(defcustom vhdl-compose-configuration-use-subconfiguration t - "Specifies whether subconfigurations should be used inside configurations. -If non-nil, automatically created configurations use configurations in binding -indications for subcomponents, if such configurations exist. Otherwise, -entities are used in binding indications for subcomponents." - :type 'boolean - :group 'vhdl-compose) - - -(defgroup vhdl-port nil - "Customizations for port translation functions." - :group 'vhdl - :group 'vhdl-compose) - -(defcustom vhdl-include-port-comments nil - "Non-nil means include port comments when a port is pasted." - :type 'boolean - :group 'vhdl-port) - -(defcustom vhdl-include-direction-comments nil - "Non-nil means include port direction in instantiations as comments." - :type 'boolean - :group 'vhdl-port) - -(defcustom vhdl-include-type-comments nil - "Non-nil means include generic/port type in instantiations as comments." - :type 'boolean - :group 'vhdl-port) - -(defcustom vhdl-include-group-comments 'never - "Specifies whether to include group comments and spacings. -The comments and empty lines between groups of ports are pasted: - Never : never - Declarations: in entity/component/constant/signal declarations only - Always : also in generic/port maps" - :type '(choice (const :tag "Never" never) - (const :tag "Declarations" decl) - (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. -In a component instantiation, an actual port name can be obtained by -modifying the formal port 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) - -(defcustom vhdl-instance-name '(".*" . "\\&_%d") - (concat - "Specifies how an instance name is obtained. -The instance name can be obtained by modifying the name of the component to be -instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced -by a unique number (starting with 1). -If TO STRING is empty, the instance name is queried." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-port) - - -(defgroup vhdl-testbench nil - "Customizations for testbench generation." - :group 'vhdl-port) - -(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb") - (concat - "Specifies how the testbench entity name is obtained. -The entity name of a testbench can be obtained by modifying the name of -the component to be tested (e.g. attaching or stripping off a substring)." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-architecture-name '(".*" . "") - (concat - "Specifies how the testbench architecture name is obtained. -The testbench architecture name can be obtained by modifying the name of -the component to be tested (e.g. attaching or stripping off a substring). -If TO STRING is empty, the architecture name is queried." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name - (concat - "Specifies how the testbench configuration name is obtained. -The configuration name of a testbench can be obtained by modifying the entity -and/or architecture name (e.g. attaching or stripping off a substring). The -string that is matched against the regexp is the concatenation of the entity -and the architecture name separated by a space. This gives access to both -names (see default setting as example)." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-dut-name '(".*" . "DUT") - (concat - "Specifies how a DUT instance name is obtained. -The design-under-test instance name (i.e. the component instantiated in the -testbench) can be obtained by modifying the component 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-testbench) - -(defcustom vhdl-testbench-include-header t - "Non-nil means include a header in automatically generated files." - :type 'boolean - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-declarations "\ - -- clock - signal Clk : std_logic := '1'; -" - "String or file to be inserted in the testbench declarative part. -If the string specifies an existing file name, the contents of the file is -inserted, otherwise the string itself is inserted in the testbench -architecture before the BEGIN keyword. -Type `C-j' for newlines." - :type 'string - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-statements "\ - -- clock generation - Clk <= not Clk after 10 ns; - - -- waveform generation - WaveGen_Proc: process - begin - -- insert signal assignments here - - wait until Clk = '1'; - end process WaveGen_Proc; -" - "String or file to be inserted in the testbench statement part. -If the string specifies an existing file name, the contents of the file is -inserted, otherwise the string itself is inserted in the testbench -architecture before the END keyword. -Type `C-j' for newlines." - :type 'string - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-initialize-signals nil - "Non-nil means initialize signals with `0' when declared in testbench." - :type 'boolean - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-include-library t - "Non-nil means a library/use clause for std_logic_1164 is included." - :type 'boolean - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-include-configuration t - "Non-nil means a testbench configuration is attached at the end." - :type 'boolean - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-create-files 'single - "Specifies whether new files should be created for the testbench. -testbench entity and architecture are inserted: - None : in current buffer - Single file : in new single file - Separate files: in two separate files -The file names are obtained from variables `vhdl-testbench-entity-file-name' -and `vhdl-testbench-architecture-file-name'." - :type '(choice (const :tag "None" none) - (const :tag "Single file" single) - (const :tag "Separate files" separate)) - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name - (concat - "Specifies how the testbench entity file name is obtained. -The entity file name can be obtained by modifying the testbench entity name -\(e.g. attaching or stripping off a substring). The file extension is -automatically taken from the file name of the current buffer. Testbench -files can be created in a different directory by prepending a relative or -absolute path to the file name." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-testbench) - -(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name - (concat - "Specifies how the testbench architecture file name is obtained. -The architecture file name can be obtained by modifying the testbench entity -and/or architecture name (e.g. attaching or stripping off a substring). The -string that is matched against the regexp is the concatenation of the entity -and the architecture name separated by a space. This gives access to both -names (see default setting as example). Testbench files can be created in -a different directory by prepending a relative or absolute path to the file -name." - vhdl-name-doc-string) - :type '(cons (regexp :tag "From regexp") - (string :tag "To string ")) - :group 'vhdl-testbench) - - -(defgroup vhdl-comment nil - "Customizations for comments." - :group 'vhdl) - -(defcustom vhdl-self-insert-comments t - "Non-nil means various templates automatically insert help comments." - :type 'boolean - :group 'vhdl-comment) - -(defcustom vhdl-prompt-for-comments t - "Non-nil means various templates prompt for user definable comments." - :type 'boolean - :group 'vhdl-comment) - -(defcustom vhdl-inline-comment-column 40 - "Column to indent and align inline comments to. -Overrides local option `comment-column'. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type 'integer - :group 'vhdl-comment) - -(defcustom vhdl-end-comment-column 79 - "End of comment column. -Comments that exceed this column number are wrapped. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type 'integer - :group 'vhdl-comment) - -(defvar end-comment-column) - - -(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-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-beautify) - -(defcustom vhdl-align-group-separate "^\\s-*$" - "Regexp for matching a line that separates groups of lines for alignment. -Examples: - \"^\\s-*$\": matches an empty line - \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" - :type 'regexp - :group 'vhdl-beautify) - -(defcustom vhdl-align-same-indent t - "Non-nil means align blocks with same indent separately. -When a region or the entire buffer is aligned, the code is divided into -blocks of same indent which are aligned separately (except for argument/port -lists). This gives nicer alignment in most cases. -Option `vhdl-align-groups' still applies within these blocks." - :type 'boolean - :group 'vhdl-beautify) - -(defcustom vhdl-beautify-options '(t t t t t) - "List of options for beautifying code. -Allows you 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 - "Customizations for highlighting." - :group 'vhdl) - -(defcustom vhdl-highlight-keywords t - "Non-nil means highlight VHDL keywords and other standardized words. -The following faces are used: - `font-lock-keyword-face' : keywords - `font-lock-type-face' : standardized types - `vhdl-font-lock-attribute-face': standardized attributes - `vhdl-font-lock-enumvalue-face': standardized enumeration values - `vhdl-font-lock-function-face' : standardized function and package names - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-names t - "Non-nil means highlight declaration names and construct labels. -The following faces are used: - `font-lock-function-name-face' : names in declarations of units, - subprograms, components, as well as labels of VHDL constructs - `font-lock-type-face' : names in type/nature declarations - `vhdl-font-lock-attribute-face': names in attribute declarations - `font-lock-variable-name-face' : names in declarations of signals, - variables, constants, subprogram parameters, generics, and ports - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-special-words nil - "Non-nil means highlight words with special syntax. -The words with syntax and color specified in option `vhdl-special-syntax-alist' -are highlighted accordingly. -Can be used for visual support of naming conventions. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-forbidden-words nil - "Non-nil means highlight forbidden words. -The reserved words specified in option `vhdl-forbidden-words' or having the -syntax specified in option `vhdl-forbidden-syntax' are highlighted in a -warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to -use them. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-words-init #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-verilog-keywords nil - "Non-nil means highlight Verilog keywords as reserved words. -Verilog keywords are highlighted in a warning color (face -`vhdl-font-lock-reserved-words-face') to indicate not to use them. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-words-init #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-translate-off nil - "Non-nil means background-highlight code excluded from translation. -That is, all code between \"-- pragma translate_off\" and -\"-- pragma translate_on\" is highlighted using a different background color -\(face `vhdl-font-lock-translate-off-face'). -Note: this might slow down on-the-fly fontification (and thus editing). - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-highlight-case-sensitive nil - "Non-nil means consider case for highlighting. -Possible trade-off: - non-nil also upper-case VHDL words are highlighted, but case of words with - special syntax is not considered - nil only lower-case VHDL words are highlighted, but case of words with - special syntax is considered -Overrides local option `font-lock-keywords-case-fold-search'. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'boolean - :group 'vhdl-highlight) - -(defcustom vhdl-special-syntax-alist - '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil) - ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil) - ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil)) - "List of special syntax to be highlighted. -If option `vhdl-highlight-special-words' is non-nil, words with the specified -syntax (as regular expression) are highlighted in the corresponding color. - - Name : string of words and spaces - Regexp : regular expression describing word syntax - (e.g., `\\=\\<\\w+_c\\>' matches word with suffix `_c') - expression must start with `\\=\\<' and end with `\\>' - if only whole words should be matched (no substrings) - Color (light): foreground color for light background - (matching color examples: Gold3, Grey50, LimeGreen, Tomato, - LightSeaGreen, DodgerBlue, Gold, PaleVioletRed) - Color (dark) : foreground color for dark background - (matching color examples: BurlyWood1, Grey80, Green, Coral, - AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1) - In comments : If non-nil, words are also highlighted inside comments - -Can be used for visual support of naming conventions, such as highlighting -different kinds of signals (e.g. `Clk50', `Rst_n') or objects (e.g. -`Signal_s', `Variable_v', `Constant_c') by distinguishing them using -common substrings or name suffices. -For each entry, a new face is generated with the specified colors and name -`vhdl-font-lock-' + name + `-face'. - -NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu - entry `Fontify Buffer'). All other changes require restarting Emacs." - :type '(repeat (list :tag "Face" :indent 2 - (string :tag "Name ") - (regexp :tag "Regexp " "\\w+_") - (string :tag "Color (light)") - (string :tag "Color (dark) ") - (boolean :tag "In comments "))) - :set (lambda (variable value) - (vhdl-custom-set variable value #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-forbidden-words '() - "List of forbidden words to be highlighted. -If option `vhdl-highlight-forbidden-words' is non-nil, these reserved -words are highlighted in a warning color to indicate not to use them. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type '(repeat (string :format "%v")) - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-words-init #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-forbidden-syntax "" - "Syntax of forbidden words to be highlighted. -If option `vhdl-highlight-forbidden-words' is non-nil, words with this -syntax are highlighted in a warning color to indicate not to use them. -Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\" -highlights identifiers with 10 or more characters). - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type 'regexp - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-words-init #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - -(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") - "List of compiler directive keywords recognized for highlighting. - -NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu - entry \"Fontify Buffer\")." - :type '(repeat (string :format "%v")) - :set (lambda (variable value) - (vhdl-custom-set variable value - #'vhdl-words-init #'vhdl-font-lock-init)) - :group 'vhdl-highlight) - - -(defgroup vhdl-speedbar nil - "Customizations for speedbar." - :group 'vhdl) - -(defcustom vhdl-speedbar-auto-open nil - "Non-nil means automatically open speedbar at startup. -Alternatively, the speedbar can be opened from the VHDL menu." - :type 'boolean - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-display-mode 'files - "Specifies the default displaying mode when opening speedbar. -Alternatively, the displaying mode can be selected from the speedbar menu or -by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)." - :type '(choice (const :tag "Files" files) - (const :tag "Directory hierarchy" directory) - (const :tag "Project hierarchy" project)) - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50)) - "Limits scanning of large files and netlists. -Design units: maximum file size to scan for design units -Hierarchy (instances of subcomponents): - File size: maximum file size to scan for instances (in bytes) - Instances per arch: maximum number of instances to scan per architecture - -\"None\" always means that there is no limit. -In case of files not or incompletely scanned, a warning message and the file -names are printed out. -Background: scanning for instances is considerably slower than scanning for -design units, especially when there are many instances. These limits should -prevent the scanning of large netlists." - :type '(list (choice :tag "Design units" - :format "%t : %[Value Menu%] %v" - (const :tag "None" nil) - (integer :tag "File size")) - (list :tag "Hierarchy" :indent 2 - (choice :tag "File size" - :format "%t : %[Value Menu%] %v" - (const :tag "None" nil) - (integer :tag "Size ")) - (choice :tag "Instances per arch" - (const :tag "None" nil) - (integer :tag "Number ")))) - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-jump-to-unit t - "Non-nil means jump to the design unit code when opened in a buffer. -The buffer cursor position is left unchanged otherwise." - :type 'boolean - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-update-on-saving t - "Automatically update design hierarchy when buffer is saved." - :type 'boolean - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-save-cache '(hierarchy display) - "Automatically save modified hierarchy caches when exiting Emacs. - Hierarchy: design hierarchy information - Display: displaying information (which design units to expand)" - :type '(set (const :tag "Hierarchy" hierarchy) - (const :tag "Display" display)) - :group 'vhdl-speedbar) - -(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2" - "Name of file for saving hierarchy cache. -\"\\1\" is replaced by the project name if a project is specified, -\"directory\" otherwise. \"\\2\" is replaced by the user name (allows for -different users to have cache files in the same directory). Can also have -an absolute path (i.e. all caches can be stored in one global directory)." - :type 'string - :group 'vhdl-speedbar) - - -(defgroup vhdl-menu nil - "Customizations for menus." - :group 'vhdl) - -(defcustom vhdl-index-menu nil - "Non-nil means add an index menu for a source file when loading. -Alternatively, the speedbar can be used. Note that the index menu scans a file -when it is opened, while speedbar only scans the file upon request." - :type 'boolean - :group 'vhdl-menu) - -(defcustom vhdl-source-file-menu nil - "Non-nil means add a menu of all source files in current directory. -Alternatively, the speedbar can be used." - :type 'boolean - :group 'vhdl-menu) - -(defcustom vhdl-hideshow-menu nil - "Non-nil means add hideshow menu and functionality at startup. -Hideshow can also be enabled from the VHDL Mode menu. -Hideshow allows hiding code of various VHDL constructs. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type 'boolean - :group 'vhdl-menu) - -(defcustom vhdl-hide-all-init nil - "Non-nil means hide all design units initially after a file is loaded." - :type 'boolean - :group 'vhdl-menu) - - -(defgroup vhdl-print nil - "Customizations for printing." - :group 'vhdl) - -(defcustom vhdl-print-two-column t - "Non-nil means print code in two columns and landscape format. -Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print') -prints VHDL files in a nice two-column landscape style. - -NOTE: Activate the new setting by restarting Emacs. - Overrides `ps-print' settings locally." - :type 'boolean - :group 'vhdl-print) - -(defcustom vhdl-print-customize-faces t - "Non-nil means use an optimized set of faces for PostScript printing. - -NOTE: Activate the new setting by restarting Emacs. - Overrides `ps-print' settings locally." - :type 'boolean - :group 'vhdl-print) - - -(defgroup vhdl-misc nil - "Miscellaneous customizations." - :group 'vhdl) - -(defcustom vhdl-intelligent-tab t - "Non-nil means `TAB' does indentation, word completion and tab insertion. -That is, if preceding character is part of a word then complete word, -else if not at beginning of line then insert tab, -else if last command was a `TAB' or `RET' then dedent one step, -else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab'). -If nil, TAB always indents current line (i.e. `TAB' is bound to -`indent-according-to-mode'). - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." - :type 'boolean - :group 'vhdl-misc) - -(defcustom vhdl-indent-syntax-based t - "Non-nil means indent lines of code based on their syntactic context. -Otherwise, a line is indented like the previous nonblank line. This can be -useful in large files where syntax-based indentation gets very slow." - :type 'boolean - :group 'vhdl-misc) - -(defcustom vhdl-indent-comment-like-next-code-line t - "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 word completion using `TAB' is case sensitive. -That is, `TAB' completes words that start with the same letters and case. -Otherwise, case is ignored." - :type 'boolean - :group 'vhdl-misc) - -(defcustom vhdl-word-completion-in-minibuffer t - "Non-nil enables word completion in minibuffer (for template prompts). - -NOTE: Activate the new setting by restarting Emacs." - :type 'boolean - :group 'vhdl-misc) - -(defcustom vhdl-underscore-is-part-of-word 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." - :type 'boolean - :group 'vhdl-misc) -(make-obsolete-variable 'vhdl-underscore-is-part-of-word - 'superword-mode "24.4") - - -(defgroup vhdl-related nil - "Related general customizations." - :group 'vhdl) - -;; add related general customizations -(custom-add-to-group 'vhdl-related 'hideshow 'custom-group) -(if (featurep 'xemacs) - (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) - (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) -(custom-add-to-group 'vhdl-related 'ps-print 'custom-group) -(custom-add-to-group 'vhdl-related 'speedbar 'custom-group) -(custom-add-to-group 'vhdl-related 'comment-style 'custom-variable) -(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) -(unless (featurep 'xemacs) - (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) -(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) -(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Hidden user variables - -(defvar vhdl-compile-absolute-path nil - "If non-nil, use absolute instead of relative path for compiled files.") - -(defvar vhdl-comment-display-line-char ?- - "Character to use in comment display line.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal variables - -(defvar vhdl-menu-max-size 20 - "Specifies the maximum size of a menu before splitting it into submenus.") - -(defvar vhdl-progress-interval 1 - "Interval used to update progress status during long operations. -If a number, percentage complete gets updated after each interval of -that many seconds. To inhibit all messages, set this option to nil.") - -(defvar vhdl-inhibit-startup-warnings-p nil - "If non-nil, inhibits start up compatibility warnings.") - -(defvar vhdl-strict-syntax-p nil - "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. -If the syntactic symbol for a particular line does not match a symbol -in the offsets alist, an error is generated, otherwise no error is -reported and the syntactic symbol is ignored.") - -(defvar vhdl-echo-syntactic-information-p nil - "If non-nil, syntactic info is echoed when the line is indented.") - -(defconst vhdl-offsets-alist-default - '((string . -1000) - (cpp-macro . -1000) - (block-open . 0) - (block-close . 0) - (statement . 0) - (statement-cont . vhdl-lineup-statement-cont) - (statement-block-intro . +) - (statement-case-intro . +) - (case-alternative . +) - (comment . vhdl-lineup-comment) - (arglist-intro . +) - (arglist-cont . 0) - (arglist-cont-nonempty . vhdl-lineup-arglist) - (arglist-close . vhdl-lineup-arglist) - (entity . 0) - (configuration . 0) - (package . 0) - (architecture . 0) - (package-body . 0) - (context . 0) - (directive . 0) - ) - "Default settings for offsets of syntactic elements. -Do not change this constant! See the variable `vhdl-offsets-alist' for -more information.") - -(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) - "Association list of syntactic element symbols and indentation offsets. -As described below, each cons cell in this list has the form: - - (SYNTACTIC-SYMBOL . OFFSET) - -When a line is indented, `vhdl-mode' first determines the syntactic -context of the line by generating a list of symbols called syntactic -elements. This list can contain more than one syntactic element and -the global variable `vhdl-syntactic-context' contains the context list -for the line being indented. Each element in this list is actually a -cons cell of the syntactic symbol and a buffer position. This buffer -position is call the relative indent point for the line. Some -syntactic symbols may not have a relative indent point associated with -them. - -After the syntactic context list for a line is generated, `vhdl-mode' -calculates the absolute indentation for the line by looking at each -syntactic element in the list. First, it compares the syntactic -element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it -finds a match, it adds the OFFSET to the column of the relative indent -point. The sum of this calculation for each element in the syntactic -list is the absolute offset for line being indented. - -If the syntactic element does not match any in the `vhdl-offsets-alist', -an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise -the element is ignored. - -Actually, OFFSET can be an integer, a function, a variable, or one of -the following symbols: `+', `-', `++', or `--'. These latter -designate positive or negative multiples of `vhdl-basic-offset', -respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is -called with a single argument containing the cons of the syntactic -element symbol and the relative indent point. The function should -return an integer offset. - -Here is the current list of valid syntactic element symbols: - - string -- inside multi-line string - block-open -- statement block open - block-close -- statement block close - statement -- a VHDL statement - statement-cont -- a continuation of a VHDL statement - statement-block-intro -- the first line in a new statement block - statement-case-intro -- the first line in a case alternative block - case-alternative -- a case statement alternative clause - comment -- a line containing only a comment - arglist-intro -- the first line in an argument list - arglist-cont -- subsequent argument list lines when no - arguments follow on the same line as - the arglist opening paren - arglist-cont-nonempty -- subsequent argument list lines when at - least one argument follows on the same - line as the arglist opening paren - arglist-close -- the solo close paren of an argument list - entity -- inside an entity declaration - configuration -- inside a configuration declaration - package -- inside a package declaration - architecture -- inside an architecture body - package-body -- inside a package body - context -- inside a context declaration") - -(defvar vhdl-comment-only-line-offset 0 - "Extra offset for line which contains only the start of a comment. -Can contain an integer or a cons cell of the form: - - (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) - -Where NON-ANCHORED-OFFSET is the amount of offset given to -non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is -the amount of offset to give column-zero anchored comment-only lines. -Just an integer as value is equivalent to (<val> . 0)") - -(defvar vhdl-special-indent-hook nil - "Hook for user defined special indentation adjustments. -This hook gets called after a line is indented by the mode.") - -(defvar vhdl-style-alist - '(("IEEE" - (vhdl-basic-offset . 4) - (vhdl-offsets-alist . ()))) - "Styles of Indentation. -Elements of this alist are of the form: - - (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) - -where STYLE-STRING is a short descriptive string used to select a -style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended -value for that variable when using the selected style. - -There is one special case when VARIABLE is `vhdl-offsets-alist'. In this -case, the VALUE is a list containing elements of the form: - - (SYNTACTIC-SYMBOL . VALUE) - -as described in `vhdl-offsets-alist'. These are passed directly to -`vhdl-set-offset' so there is no need to set every syntactic symbol in -your style, only those that are different from the default.") - -;; dynamically append the default value of most variables -(or (assoc "Default" vhdl-style-alist) - (let* ((varlist '(vhdl-inhibit-startup-warnings-p - vhdl-strict-syntax-p - vhdl-echo-syntactic-information-p - vhdl-basic-offset - vhdl-offsets-alist - vhdl-comment-only-line-offset)) - (default (cons "Default" - (mapcar - (function - (lambda (var) - (cons var (symbol-value var)))) - varlist)))) - (push default vhdl-style-alist))) - -(defvar vhdl-mode-hook nil - "Hook called by `vhdl-mode'.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Required packages -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; mandatory -(require 'compile) ; XEmacs -(when (< emacs-major-version 28) ; preloaded in Emacs 28 - (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))) ; for speedbar-with-writable - -(defun vhdl-aput (alist-symbol key &optional value) - "Insert a key-value pair into an alist. -The alist is referenced by ALIST-SYMBOL. The key-value pair is made -from KEY and VALUE. If the key-value pair referenced by KEY can be -found in the alist, the value of KEY will be set to VALUE. If the -key-value pair cannot be found in the alist, it will be inserted into -the head of the alist." - (let* ((alist (symbol-value alist-symbol)) - (elem (assoc key alist))) - (if elem - (setcdr elem value) - (set alist-symbol (cons (cons key value) alist))))) - -(defun vhdl-adelete (alist-symbol key) - "Delete a key-value pair from the alist. -Alist is referenced by ALIST-SYMBOL and the key-value pair to remove -is pair matching KEY." - (let ((alist (symbol-value alist-symbol)) alist-cdr) - (while (equal key (caar alist)) - (setq alist (cdr alist)) - (set alist-symbol alist)) - (while (setq alist-cdr (cdr alist)) - (if (equal key (caar alist-cdr)) - (setcdr alist (cdr alist-cdr)) - (setq alist alist-cdr))))) - -(defun vhdl-aget (alist key) - "Return the value in ALIST that is associated with KEY. -If KEY is not found, then nil is returned." - (cdr (assoc key alist))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatibility -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; XEmacs compatibility - -;; active regions -(defun vhdl-keep-region-active () - "Do whatever is necessary to keep the region active in XEmacs. -Ignore byte-compiler warnings you might see." - (and (featurep 'xemacs) - (setq zmacs-region-stays t))) - -;; `wildcard-to-regexp' is included only in XEmacs 21 -(unless (fboundp 'wildcard-to-regexp) - (defun wildcard-to-regexp (wildcard) - "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'." - (let* ((i (string-match "[*?]" wildcard)) - (result (substring wildcard 0 i)) - (len (length wildcard))) - (when i - (while (< i len) - (let ((ch (aref wildcard i))) - (setq result (concat result - (cond ((eq ch ?*) "[^\000]*") - ((eq ch ??) "[^\000]") - (t (char-to-string ch))))) - (setq i (1+ i))))) - (concat "\\`" result "\\'")))) - -;; `regexp-opt' undefined (`xemacs-devel' not installed) -;; `regexp-opt' accelerates fontification by 10-20% -(unless (fboundp 'regexp-opt) -; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") - (defun regexp-opt (strings &optional paren) - (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat #'regexp-quote strings "\\|") close)))) - -;; `match-string-no-properties' undefined (XEmacs, what else?) -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties #'match-string)) - -;; `subst-char-in-string' undefined (XEmacs) -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) - newstr))) - -;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) -(when (and (featurep 'xemacs) (string< itimer-version "1.09") - (not noninteractive)) - (load "itimer") - (when (string< itimer-version "1.09") - (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") - (beep) (sit-for 5))) - -;; `file-expand-wildcards' undefined (XEmacs) -(unless (fboundp 'file-expand-wildcards) - (defun file-expand-wildcards (pattern &optional full) - "Taken from Emacs's `files.el'." - (let* ((nondir (file-name-nondirectory pattern)) - (dirpart (file-name-directory pattern)) - (dirs (if (and dirpart (string-match "[[*?]" dirpart)) - (mapcar #'file-name-as-directory - (file-expand-wildcards (directory-file-name dirpart))) - (list dirpart))) - contents) - (while dirs - (when (or (null (car dirs)) ; Possible if DIRPART is not wild. - (file-directory-p (directory-file-name (car dirs)))) - (let ((this-dir-contents - (delq nil - (mapcar #'(lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) - (directory-files (or (car dirs) ".") full - (wildcard-to-regexp nondir)))))) - (setq contents - (nconc - (if (and (car dirs) (not full)) - (mapcar (lambda (name) (concat (car dirs) name)) - this-dir-contents) - this-dir-contents) - contents)))) - (setq dirs (cdr dirs))) - contents))) - -;; `member-ignore-case' undefined (XEmacs) -(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)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Compatibility with older VHDL Mode versions - -(defvar vhdl-warnings nil - "Warnings to tell the user during start up.") - -(defun vhdl-run-when-idle (secs repeat function) - "Wait until idle, then run FUNCTION." - (if (fboundp 'start-itimer) ;;XEmacs - (start-itimer "vhdl-mode" function secs repeat t) - ;; explicitly activate timer (necessary when Emacs is already idle) - (let ((timer (run-with-idle-timer secs repeat function))) - ;; `run-with-idle-timer' already sets the `triggered' flag to nil, - ;; at least since Emacs-24. - (if (< emacs-major-version 24) (aset timer 0 nil))))) - -(defun vhdl-warning-when-idle (&rest args) - "Wait until idle, then print out warning STRING and beep." - (let ((message (apply #'format-message args))) - (if noninteractive - (vhdl-warning message t) - (unless vhdl-warnings - (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) - (push message vhdl-warnings)))) - -(defun vhdl-warning (string &optional nobeep) - "Print out warning STRING and beep." - (message "WARNING: %s" string) - (unless (or nobeep noninteractive) (beep))) - -(defun vhdl-print-warnings () - "Print out messages in variable `vhdl-warnings'." - (let ((no-warnings (length vhdl-warnings))) - (setq vhdl-warnings (nreverse vhdl-warnings)) - (while vhdl-warnings - (message "WARNING: %s" (car vhdl-warnings)) - (setq vhdl-warnings (cdr vhdl-warnings))) - (beep) - (when (> no-warnings 1) - (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) - -;; Backward compatibility checks and fixes -;; option `vhdl-compiler' changed format -(unless (stringp vhdl-compiler) - (setq vhdl-compiler "ModelSim") - (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) - -;; option `vhdl-standard' changed format -(unless (listp vhdl-standard) - (setq vhdl-standard '(87 nil)) - (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) - -;; option `vhdl-model-alist' changed format -(when (= (length (car vhdl-model-alist)) 3) - (let ((old-alist vhdl-model-alist) - new-alist) - (while old-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)) - -;; option `vhdl-project-alist' changed format -(when (= (length (car vhdl-project-alist)) 3) - (let ((old-alist vhdl-project-alist) - new-alist) - (while old-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)) - -;; option `vhdl-project-alist' changed format (3.31.1) -(when (= (length (car vhdl-project-alist)) 4) - (let ((old-alist vhdl-project-alist) - new-alist elem) - (while old-alist - (setq elem (car old-alist)) - (setq new-alist - (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) - nil "./" "work" "work/" "Makefile" (nth 3 elem)) - new-alist)) - (setq old-alist (cdr old-alist))) - (setq vhdl-project-alist (nreverse new-alist))) - (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) - -;; option `vhdl-project-alist' changed format (3.31.12) -(when (= (length (car vhdl-project-alist)) 10) - (let ((tmp-alist vhdl-project-alist)) - (while tmp-alist - (setcdr (nthcdr 3 (car tmp-alist)) - (cons "" (nthcdr 4 (car tmp-alist)))) - (setq tmp-alist (cdr tmp-alist)))) - (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) - -;; option `vhdl-compiler-alist' changed format (3.31.1) -(when (= (length (car vhdl-compiler-alist)) 7) - (let ((old-alist vhdl-compiler-alist) - new-alist elem) - (while old-alist - (setq elem (car old-alist)) - (setq new-alist - (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" - (if (equal (nth 3 elem) "") nil (nth 3 elem)) - (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) - (nth 5 elem) (nth 6 elem) nil) - new-alist)) - (setq old-alist (cdr old-alist))) - (setq vhdl-compiler-alist (nreverse new-alist))) - (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) - -;; option `vhdl-compiler-alist' changed format (3.31.10) -(when (= (length (car vhdl-compiler-alist)) 12) - (let ((tmp-alist vhdl-compiler-alist)) - (while tmp-alist - (setcdr (nthcdr 4 (car tmp-alist)) - (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) - (setq tmp-alist (cdr tmp-alist)))) - (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) - -;; option `vhdl-compiler-alist' changed format (3.31.11) -(when (= (length (car vhdl-compiler-alist)) 13) - (let ((tmp-alist vhdl-compiler-alist)) - (while tmp-alist - (setcdr (nthcdr 3 (car tmp-alist)) - (cons "" (nthcdr 4 (car tmp-alist)))) - (setq tmp-alist (cdr tmp-alist)))) - (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) - -;; option `vhdl-compiler-alist' changed format (3.32.7) -(when (= (length (nth 11 (car vhdl-compiler-alist))) 3) - (let ((tmp-alist vhdl-compiler-alist)) - (while tmp-alist - (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) - '(0 . nil)) - (setq tmp-alist (cdr tmp-alist)))) - (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) - -;; option `vhdl-project': empty value changed from "" to nil (3.31.1) -(when (equal vhdl-project "") - (setq vhdl-project nil) - (customize-save-variable 'vhdl-project vhdl-project)) - -;; option `vhdl-project-file-name': changed format (3.31.17 beta) -(when (stringp vhdl-project-file-name) - (setq vhdl-project-file-name (list vhdl-project-file-name)) - (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) - -;; option `speedbar-indentation-width': introduced in speedbar 0.10 -(if (not (boundp 'speedbar-indentation-width)) - (defvar speedbar-indentation-width 2) - ;; set default to 2 if not already customized - (unless (get 'speedbar-indentation-width 'saved-value) - (setq speedbar-indentation-width 2))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Help functions / inline substitutions / macros -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vhdl-standard-p (standard) - "Check if STANDARD is specified as used standard." - (or (eq standard (car vhdl-standard)) - (memq standard (cadr vhdl-standard)))) - -(defun vhdl-project-p (&optional warning) - "Return non-nil if a project is displayed, i.e. directories or files are -specified." - (if (assoc vhdl-project vhdl-project-alist) - vhdl-project - (when (and vhdl-project warning) - (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) - nil)) - -(defun vhdl-resolve-env-variable (string) - "Resolve environment variables in STRING." - (while (string-match "\\(.*\\)\\${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) - (setq string (concat (match-string 1 string) - (getenv (match-string 2 string)) - (match-string 4 string)))) - string) - -(defun vhdl-default-directory () - "Return the default directory of the current project or the directory of the -current buffer if no project is defined." - (if (vhdl-project-p) - (expand-file-name (vhdl-resolve-env-variable - (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) - default-directory)) - -(defmacro vhdl-prepare-search-1 (&rest body) - "Enable case insensitive search and switch to syntax table that includes `_', -then execute BODY, and finally restore the old environment. Used for -consistent searching." - (declare (debug t)) - `(let ((case-fold-search t)) ; case insensitive search - ;; use extended syntax table - (with-syntax-table vhdl-mode-ext-syntax-table - ,@body))) - -(defmacro vhdl-prepare-search-2 (&rest body) - "Enable case insensitive search, switch to syntax table that includes `_', -then execute BODY, and finally restore the old environment. -Used for consistent searching." - (declare (debug t)) - `(let ((case-fold-search t)) ; case insensitive search - ;; use extended syntax table - (with-syntax-table vhdl-mode-ext-syntax-table - ;; execute BODY safely - (progn ,@body)))) - -(defmacro vhdl-visit-file (file-name issue-error &rest body) - "Visit file FILE-NAME and execute BODY." - (declare (debug t) (indent 2)) - `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body))) - -(defun vhdl--visit-file (file-name issue-error body-fun) - (if (null file-name) - (funcall body-fun) - (unless (file-directory-p file-name) - (let ((source-buffer (current-buffer)) - (visiting-buffer (find-buffer-visiting file-name)) - file-opened) - (when (or (and visiting-buffer (set-buffer visiting-buffer)) - (condition-case () - (progn (set-buffer (create-file-buffer file-name)) - (setq file-opened t) - (vhdl-insert-file-contents file-name) - (let ((st (copy-syntax-table (syntax-table)))) - (modify-syntax-entry ?\- ". 12" st) - (modify-syntax-entry ?\n ">" st) - (modify-syntax-entry ?\^M ">" st) - (modify-syntax-entry ?_ "w" st) - ;; FIXME: We should arguably reset the - ;; syntax-table after running `body-fun'. - (set-syntax-table st)) - t) - (error - (if issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error "ERROR: File cannot be opened: \"%s\"" file-name)) - (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t) - nil)))) - (condition-case info - (funcall body-fun) - (error - (if issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error (cadr info))) - (vhdl-warning (cadr info)))))) - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer))))) - -(defun vhdl-insert-file-contents (filename) - "Nicked from `insert-file-contents-literally', but allow coding system -conversion." - (let ((format-alist nil) - (after-insert-file-functions nil) - (jka-compr-compression-info-list nil)) - (insert-file-contents filename t))) - -(defun vhdl-sort-alist (alist) - "Sort ALIST." - (sort alist (lambda (a b) (string< (car a) (car b))))) - -(defun vhdl-get-subdirs (directory) - "Recursively get subdirectories of DIRECTORY." - (let ((dir-list (list (file-name-as-directory directory))) - file-list) - (setq file-list (vhdl-directory-files directory t "\\w.*")) - (while file-list - (when (file-directory-p (car file-list)) - (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) - (setq file-list (cdr file-list))) - dir-list)) - -(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) - "As `aput', but delete key-value pair if VALUE is nil." - (if value - (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." - (push nil list) - (let ((list1 list)) - (while (and (cdr list1) (not (equal elt (cadr list1)))) - (setq list1 (cdr list1))) - (when list - (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) - (frame-live-p speedbar-frame)) - (let (;; (pos (point)) - (last-frame (selected-frame))) - (if (null key) - (speedbar-refresh) - (select-frame speedbar-frame) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) - (goto-char (match-end 1)) - (speedbar-do-function-pointer) - (backward-char 2) - (speedbar-do-function-pointer) - (message "Refreshing speedbar...done")) - (select-frame last-frame))))) - -(defun vhdl-show-messages () - "Get *Messages* buffer to show recent messages." - (interactive) - (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) - -(defun vhdl-use-direct-instantiation () - "Return whether direct instantiation is used." - (or (eq vhdl-use-direct-instantiation 'always) - (and (eq vhdl-use-direct-instantiation 'standard) - (not (vhdl-standard-p '87))))) - -(defun vhdl-max-marker (marker1 marker2) - "Return larger marker." - (if (> marker1 marker2) marker1 marker2)) - -(defun vhdl-goto-marker (marker) - "Goto marker in appropriate buffer." - (when (markerp marker) - (set-buffer (marker-buffer marker))) - (goto-char marker)) - -(defun vhdl-menu-split (list title) - "Split menu LIST into several submenus, if number of -elements > `vhdl-menu-max-size'." - (if (> (length list) vhdl-menu-max-size) - (let ((remain list) - (result '()) - (sublist '()) - (menuno 1) - (i 0)) - (while remain - (push (car remain) sublist) - (setq remain (cdr remain)) - (setq i (+ i 1)) - (if (= i vhdl-menu-max-size) - (progn - (push (cons (format "%s %s" title menuno) - (nreverse sublist)) result) - (setq i 0) - (setq menuno (+ menuno 1)) - (setq sublist '())))) - (and sublist - (push (cons (format "%s %s" title menuno) - (nreverse sublist)) result)) - (nreverse result)) - list)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Bindings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Key bindings - -(defvar vhdl-template-map nil - "Keymap for VHDL templates.") - -(defun vhdl-template-map-init () - "Initialize `vhdl-template-map'." - (setq vhdl-template-map (make-sparse-keymap)) - ;; key bindings for VHDL templates - (define-key vhdl-template-map "al" #'vhdl-template-alias) - (define-key vhdl-template-map "ar" #'vhdl-template-architecture) - (define-key vhdl-template-map "at" #'vhdl-template-assert) - (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl) - (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec) - (define-key vhdl-template-map "bl" #'vhdl-template-block) - (define-key vhdl-template-map "ca" #'vhdl-template-case-is) - (define-key vhdl-template-map "cd" #'vhdl-template-component-decl) - (define-key vhdl-template-map "ci" #'vhdl-template-component-inst) - (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst) - (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration) - (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf) - (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl) - (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec) - (define-key vhdl-template-map "co" #'vhdl-template-constant) - (define-key vhdl-template-map "ct" #'vhdl-template-context) - (define-key vhdl-template-map "di" #'vhdl-template-disconnect) - (define-key vhdl-template-map "el" #'vhdl-template-else) - (define-key vhdl-template-map "ei" #'vhdl-template-elsif) - (define-key vhdl-template-map "en" #'vhdl-template-entity) - (define-key vhdl-template-map "ex" #'vhdl-template-exit) - (define-key vhdl-template-map "fi" #'vhdl-template-file) - (define-key vhdl-template-map "fg" #'vhdl-template-for-generate) - (define-key vhdl-template-map "fl" #'vhdl-template-for-loop) - (define-key vhdl-template-map "\C-f" #'vhdl-template-footer) - (define-key vhdl-template-map "fb" #'vhdl-template-function-body) - (define-key vhdl-template-map "fd" #'vhdl-template-function-decl) - (define-key vhdl-template-map "ge" #'vhdl-template-generic) - (define-key vhdl-template-map "gd" #'vhdl-template-group-decl) - (define-key vhdl-template-map "gt" #'vhdl-template-group-template) - (define-key vhdl-template-map "\C-h" #'vhdl-template-header) - (define-key vhdl-template-map "ig" #'vhdl-template-if-generate) - (define-key vhdl-template-map "it" #'vhdl-template-if-then) - (define-key vhdl-template-map "li" #'vhdl-template-library) - (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop) - (define-key vhdl-template-map "\C-m" #'vhdl-template-modify) - (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date) - (define-key vhdl-template-map "ma" #'vhdl-template-map) - (define-key vhdl-template-map "ne" #'vhdl-template-next) - (define-key vhdl-template-map "ot" #'vhdl-template-others) - (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl) - (define-key vhdl-template-map "Pb" #'vhdl-template-package-body) - (define-key vhdl-template-map "(" #'vhdl-template-paired-parens) - (define-key vhdl-template-map "po" #'vhdl-template-port) - (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body) - (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl) - (define-key vhdl-template-map "pc" #'vhdl-template-process-comb) - (define-key vhdl-template-map "ps" #'vhdl-template-process-seq) - (define-key vhdl-template-map "rp" #'vhdl-template-report) - (define-key vhdl-template-map "rt" #'vhdl-template-return) - (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst) - (define-key vhdl-template-map "si" #'vhdl-template-signal) - (define-key vhdl-template-map "su" #'vhdl-template-subtype) - (define-key vhdl-template-map "ty" #'vhdl-template-type) - (define-key vhdl-template-map "us" #'vhdl-template-use) - (define-key vhdl-template-map "va" #'vhdl-template-variable) - (define-key vhdl-template-map "wa" #'vhdl-template-wait) - (define-key vhdl-template-map "wl" #'vhdl-template-while-loop) - (define-key vhdl-template-map "wi" #'vhdl-template-with) - (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait) - (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit) - (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std) - (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164) - (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith) - (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc) - (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed) - (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio) - (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned) - (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio) - (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on) - (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off) - (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on) - (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off) - (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt) - (when (vhdl-standard-p 'ams) - (define-key vhdl-template-map "br" #'vhdl-template-break) - (define-key vhdl-template-map "cu" #'vhdl-template-case-use) - (define-key vhdl-template-map "iu" #'vhdl-template-if-use) - (define-key vhdl-template-map "lm" #'vhdl-template-limit) - (define-key vhdl-template-map "na" #'vhdl-template-nature) - (define-key vhdl-template-map "pa" #'vhdl-template-procedural) - (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free) - (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch) - (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source) - (define-key vhdl-template-map "sn" #'vhdl-template-subnature) - (define-key vhdl-template-map "te" #'vhdl-template-terminal) - ) - (when (vhdl-standard-p 'math) - (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex) - (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real) - )) - -;; initialize template map for VHDL Mode -(vhdl-template-map-init) - -(defun vhdl-function-name (prefix string &optional postfix) - "Generate a Lisp function name. -PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in -STRING are replaced by `-' and substrings are converted to lower case." - (let ((name prefix)) - (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) - (setq name - (concat name "-" (downcase (substring string 0 (match-end 1))))) - (setq string (substring string (match-beginning 2)))) - (when postfix (setq name (concat name "-" postfix))) - (intern name))) - -(defvar vhdl-model-map nil - "Keymap for VHDL models.") - -(defun vhdl-model-map-init () - "Initialize `vhdl-model-map'." - (setq vhdl-model-map (make-sparse-keymap)) - ;; key bindings for VHDL models - (let ((model-alist vhdl-model-alist) model) - (while model-alist - (setq model (car model-alist)) - (define-key vhdl-model-map (nth 2 model) - (vhdl-function-name "vhdl-model" (nth 0 model))) - (setq model-alist (cdr model-alist))))) - -;; initialize user model map for VHDL Mode -(vhdl-model-map-init) - -(defvar vhdl-mode-map nil - "Keymap for VHDL Mode.") - -(defun vhdl-mode-map-init () - "Initialize `vhdl-mode-map'." - (setq vhdl-mode-map (make-sparse-keymap)) - ;; template key bindings - (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) - ;; model key bindings - (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) - ;; standard key bindings - (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement) - (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement) - (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp) - (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp) - (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list) - (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent) - (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent) - (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs - (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) - ;; 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-s\C-p" #'vhdl-set-project) - (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project) - (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project) - (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project) - (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler) - (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile) - (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make) - (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile) - (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity) - (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component) - (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance) - (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals) - (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants) - (define-key vhdl-mode-map - ;; `... C-g' not allowed in XEmacs. - (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g") - #'vhdl-port-paste-generic-map) - (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations) - (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench) - (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten) - (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction) - (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration) - (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body) - (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call) - (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten) - (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component) - (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component) - (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components) - (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration) - (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package) - (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region) - (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline) - (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line) - (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode) - (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group) - (define-key vhdl-mode-map "\M-\C-\\" #'indent-region) - (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent) - (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list) - (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations) - (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region) - (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group) - (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region) - (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group) - (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent) - (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region) - (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill) - (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy) - (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank) - (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand) - (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next) - (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous) - (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) - (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region) - (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer) - (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region) - (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer) - (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process) - (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer) - (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages) - (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode) - (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version) - (define-key vhdl-mode-map "\M-\t" #'insert-tab) - ;; insert commands bindings - (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct) - (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package) - (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive) - (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert) - ;; electric key bindings - (define-key vhdl-mode-map " " #'vhdl-electric-space) - (when vhdl-intelligent-tab - (define-key vhdl-mode-map "\t" #'vhdl-electric-tab)) - (define-key vhdl-mode-map "\r" #'vhdl-electric-return) - (define-key vhdl-mode-map "-" #'vhdl-electric-dash) - (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket) - (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket) - (define-key vhdl-mode-map "'" #'vhdl-electric-quote) - (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon) - (define-key vhdl-mode-map "," #'vhdl-electric-comma) - (define-key vhdl-mode-map "." #'vhdl-electric-period) - (when (vhdl-standard-p 'ams) - (define-key vhdl-mode-map "=" #'vhdl-electric-equal))) - -;; initialize mode map for VHDL Mode -(vhdl-mode-map-init) - -;; define special minibuffer keymap for enabling word completion in minibuffer -;; (useful in template generator prompts) -(defvar vhdl-minibuffer-local-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (when vhdl-word-completion-in-minibuffer - (define-key map "\t" #'vhdl-minibuffer-tab)) - map) - "Keymap for minibuffer used in VHDL Mode.") - -;; set up electric character functions to work with -;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) -(mapc - (lambda (sym) - (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) - (put sym 'pending-delete t)) ; for `pending-delete-mode' (XEmacs) - '(vhdl-electric-space - vhdl-electric-tab - vhdl-electric-return - vhdl-electric-dash - vhdl-electric-open-bracket - vhdl-electric-close-bracket - vhdl-electric-quote - vhdl-electric-semicolon - vhdl-electric-comma - vhdl-electric-period - vhdl-electric-equal)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Syntax table - -(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) - ;; single-line comments - (modify-syntax-entry ?\- ". 12b" st) - ;; multi-line comments - (modify-syntax-entry ?\/ ". 14b" st) - (modify-syntax-entry ?* ". 23" st) - (modify-syntax-entry ?\n "> b" st) - (modify-syntax-entry ?\^M "> b" st) - ;; define parentheses to match - (modify-syntax-entry ?\( "()" st) - (modify-syntax-entry ?\) ")(" st) - (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 - ;; 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.") - -(defvar vhdl-syntactic-context nil - "Buffer local variable containing syntactic analysis list.") -(make-variable-buffer-local 'vhdl-syntactic-context) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Abbrev hook bindings - -(defvar vhdl-mode-abbrev-table nil - "Abbrev table to use in `vhdl-mode' buffers.") - -(defun vhdl-mode-abbrev-table-init () - "Initialize `vhdl-mode-abbrev-table'." - (define-abbrev-table 'vhdl-mode-abbrev-table - (append - (when (memq 'vhdl vhdl-electric-keywords) - ;; 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) - ("access" . vhdl-template-default-hook) - ("after" . vhdl-template-default-hook) - ("alias" . vhdl-template-alias-hook) - ("all" . vhdl-template-default-hook) - ("and" . vhdl-template-default-hook) - ("arch" . vhdl-template-architecture-hook) - ("architecture" . vhdl-template-architecture-hook) - ("array" . vhdl-template-default-hook) - ("assert" . vhdl-template-assert-hook) - ("attr" . vhdl-template-attribute-hook) - ("attribute" . vhdl-template-attribute-hook) - ("begin" . vhdl-template-default-indent-hook) - ("block" . vhdl-template-block-hook) - ("body" . vhdl-template-default-hook) - ("buffer" . vhdl-template-default-hook) - ("bus" . vhdl-template-default-hook) - ("case" . vhdl-template-case-hook) - ("comp" . vhdl-template-component-hook) - ("component" . vhdl-template-component-hook) - ("cond" . vhdl-template-conditional-signal-asst-hook) - ("conditional" . vhdl-template-conditional-signal-asst-hook) - ("conf" . vhdl-template-configuration-hook) - ("configuration" . vhdl-template-configuration-hook) - ("cons" . vhdl-template-constant-hook) - ("constant" . vhdl-template-constant-hook) - ("context" . vhdl-template-context-hook) - ("disconnect" . vhdl-template-disconnect-hook) - ("downto" . vhdl-template-default-hook) - ("else" . vhdl-template-else-hook) - ("elseif" . vhdl-template-elsif-hook) - ("elsif" . vhdl-template-elsif-hook) - ("end" . vhdl-template-default-indent-hook) - ("entity" . vhdl-template-entity-hook) - ("exit" . vhdl-template-exit-hook) - ("file" . vhdl-template-file-hook) - ("for" . vhdl-template-for-hook) - ("func" . vhdl-template-function-hook) - ("function" . vhdl-template-function-hook) - ("generic" . vhdl-template-generic-hook) - ("group" . vhdl-template-group-hook) - ("guarded" . vhdl-template-default-hook) - ("if" . vhdl-template-if-hook) - ("impure" . vhdl-template-default-hook) - ("in" . vhdl-template-default-hook) - ("inertial" . vhdl-template-default-hook) - ("inout" . vhdl-template-default-hook) - ("inst" . vhdl-template-instance-hook) - ("instance" . vhdl-template-instance-hook) - ("is" . vhdl-template-default-hook) - ("label" . vhdl-template-default-hook) - ("library" . vhdl-template-library-hook) - ("linkage" . vhdl-template-default-hook) - ("literal" . vhdl-template-default-hook) - ("loop" . vhdl-template-bare-loop-hook) - ("map" . vhdl-template-map-hook) - ("mod" . vhdl-template-default-hook) - ("nand" . vhdl-template-default-hook) - ("new" . vhdl-template-default-hook) - ("next" . vhdl-template-next-hook) - ("nor" . vhdl-template-default-hook) - ("not" . vhdl-template-default-hook) - ("null" . vhdl-template-default-hook) - ("of" . vhdl-template-default-hook) - ("on" . vhdl-template-default-hook) - ("open" . vhdl-template-default-hook) - ("or" . vhdl-template-default-hook) - ("others" . vhdl-template-others-hook) - ("out" . vhdl-template-default-hook) - ("pack" . vhdl-template-package-hook) - ("package" . vhdl-template-package-hook) - ("port" . vhdl-template-port-hook) - ("postponed" . vhdl-template-default-hook) - ("procedure" . vhdl-template-procedure-hook) - ("process" . vhdl-template-process-hook) - ("pure" . vhdl-template-default-hook) - ("range" . vhdl-template-default-hook) - ("record" . vhdl-template-default-hook) - ("register" . vhdl-template-default-hook) - ("reject" . vhdl-template-default-hook) - ("rem" . vhdl-template-default-hook) - ("report" . vhdl-template-report-hook) - ("return" . vhdl-template-return-hook) - ("rol" . vhdl-template-default-hook) - ("ror" . vhdl-template-default-hook) - ("select" . vhdl-template-selected-signal-asst-hook) - ("severity" . vhdl-template-default-hook) - ("shared" . vhdl-template-default-hook) - ("sig" . vhdl-template-signal-hook) - ("signal" . vhdl-template-signal-hook) - ("sla" . vhdl-template-default-hook) - ("sll" . vhdl-template-default-hook) - ("sra" . vhdl-template-default-hook) - ("srl" . vhdl-template-default-hook) - ("subtype" . vhdl-template-subtype-hook) - ("then" . vhdl-template-default-hook) - ("to" . vhdl-template-default-hook) - ("transport" . vhdl-template-default-hook) - ("type" . vhdl-template-type-hook) - ("unaffected" . vhdl-template-default-hook) - ("units" . vhdl-template-default-hook) - ("until" . vhdl-template-default-hook) - ("use" . vhdl-template-use-hook) - ("var" . vhdl-template-variable-hook) - ("variable" . vhdl-template-variable-hook) - ("wait" . vhdl-template-wait-hook) - ("when" . vhdl-template-when-hook) - ("while" . vhdl-template-while-loop-hook) - ("with" . vhdl-template-with-hook) - ("xnor" . vhdl-template-default-hook) - ("xor" . vhdl-template-default-hook) - ))) - ;; VHDL-AMS keywords - (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) - (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) - ("limit" . vhdl-template-limit-hook) - ("nature" . vhdl-template-nature-hook) - ("noise" . vhdl-template-default-hook) - ("procedural" . vhdl-template-procedural-hook) - ("quantity" . vhdl-template-quantity-hook) - ("reference" . vhdl-template-default-hook) - ("spectrum" . vhdl-template-default-hook) - ("subnature" . vhdl-template-subnature-hook) - ("terminal" . vhdl-template-terminal-hook) - ("through" . vhdl-template-default-hook) - ("tolerance" . vhdl-template-default-hook) - ))) - ;; user model keywords - (when (memq 'user vhdl-electric-keywords) - (let (abbrev-list keyword) - (dolist (elem vhdl-model-alist) - (setq keyword (nth 3 elem)) - (unless (equal keyword "") - (push (list keyword "" - (vhdl-function-name - "vhdl-model" (nth 0 elem) "hook") - 0 'system) - abbrev-list))) - abbrev-list))))) - -;; initialize abbrev table for VHDL Mode -(vhdl-mode-abbrev-table-init) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Template completion lists - -(defvar vhdl-template-construct-alist nil - "List of built-in construct templates.") - -(defun vhdl-template-construct-alist-init () - "Initialize `vhdl-template-construct-alist'." - (setq - vhdl-template-construct-alist - (append - '( - ("alias declaration" vhdl-template-alias) - ("architecture body" vhdl-template-architecture) - ("assertion" vhdl-template-assert) - ("attribute declaration" vhdl-template-attribute-decl) - ("attribute specification" vhdl-template-attribute-spec) - ("block configuration" vhdl-template-block-configuration) - ("block statement" vhdl-template-block) - ("case statement" vhdl-template-case-is) - ("component configuration" vhdl-template-component-conf) - ("component declaration" vhdl-template-component-decl) - ("component instantiation statement" vhdl-template-component-inst) - ("conditional signal assignment" vhdl-template-conditional-signal-asst) - ("configuration declaration" vhdl-template-configuration-decl) - ("configuration specification" vhdl-template-configuration-spec) - ("constant declaration" vhdl-template-constant) - ("context declaration" vhdl-template-context) - ("disconnection specification" vhdl-template-disconnect) - ("entity declaration" vhdl-template-entity) - ("exit statement" vhdl-template-exit) - ("file declaration" vhdl-template-file) - ("generate statement" vhdl-template-generate) - ("generic clause" vhdl-template-generic) - ("group declaration" vhdl-template-group-decl) - ("group template declaration" vhdl-template-group-template) - ("if statement" vhdl-template-if-then) - ("library clause" vhdl-template-library) - ("loop statement" vhdl-template-loop) - ("next statement" vhdl-template-next) - ("package declaration" vhdl-template-package-decl) - ("package body" vhdl-template-package-body) - ("port clause" vhdl-template-port) - ("process statement" vhdl-template-process) - ("report statement" vhdl-template-report) - ("return statement" vhdl-template-return) - ("selected signal assignment" vhdl-template-selected-signal-asst) - ("signal declaration" vhdl-template-signal) - ("subprogram declaration" vhdl-template-subprogram-decl) - ("subprogram body" vhdl-template-subprogram-body) - ("subtype declaration" vhdl-template-subtype) - ("type declaration" vhdl-template-type) - ("use clause" vhdl-template-use) - ("variable declaration" vhdl-template-variable) - ("wait statement" vhdl-template-wait) - ) - (when (vhdl-standard-p 'ams) - '( - ("break statement" vhdl-template-break) - ("nature declaration" vhdl-template-nature) - ("quantity declaration" vhdl-template-quantity) - ("simultaneous case statement" vhdl-template-case-use) - ("simultaneous if statement" vhdl-template-if-use) - ("simultaneous procedural statement" vhdl-template-procedural) - ("step limit specification" vhdl-template-limit) - ("subnature declaration" vhdl-template-subnature) - ("terminal declaration" vhdl-template-terminal) - ))))) - -;; initialize for VHDL Mode -(vhdl-template-construct-alist-init) - -(defvar vhdl-template-package-alist nil - "List of built-in package templates.") - -(defun vhdl-template-package-alist-init () - "Initialize `vhdl-template-package-alist'." - (setq - vhdl-template-package-alist - (append - '( - ("numeric_bit" vhdl-template-package-numeric-bit) - ("numeric_std" vhdl-template-package-numeric-std) - ("std_logic_1164" vhdl-template-package-std-logic-1164) - ("std_logic_arith" vhdl-template-package-std-logic-arith) - ("std_logic_misc" vhdl-template-package-std-logic-misc) - ("std_logic_signed" vhdl-template-package-std-logic-signed) - ("std_logic_textio" vhdl-template-package-std-logic-textio) - ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) - ("textio" vhdl-template-package-textio) - ) - (when (vhdl-standard-p 'math) - '( - ("math_complex" vhdl-template-package-math-complex) - ("math_real" vhdl-template-package-math-real) - ))))) - -;; initialize for VHDL Mode -(vhdl-template-package-alist-init) - -(defvar vhdl-template-directive-alist - '( - ("translate_on" vhdl-template-directive-translate-on) - ("translate_off" vhdl-template-directive-translate-off) - ("synthesis_on" vhdl-template-directive-synthesis-on) - ("synthesis_off" vhdl-template-directive-synthesis-off) - ) - "List of built-in directive templates.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Menus -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; VHDL menu (using `easy-menu.el') - -(defun vhdl-customize () - "Call the customize function with `vhdl' as argument." - (interactive) - (customize-browse 'vhdl)) - -(defun vhdl-create-mode-menu () - "Create VHDL Mode menu." - `("VHDL" - ,(append - '("Project" - ["None" (vhdl-set-project "") - :style radio :selected (null vhdl-project)] - "--") - ;; add menu entries for defined projects - (let ((project-alist vhdl-project-alist) menu-list name) - (while project-alist - (setq name (caar project-alist)) - (setq menu-list - (cons `[,name (vhdl-set-project ,name) - :style radio :selected (equal ,name vhdl-project)] - menu-list)) - (setq project-alist (cdr project-alist))) - (setq menu-list - (if vhdl-project-sort - (sort menu-list - (lambda (a b) (string< (elt a 0) (elt b 0)))) - (nreverse menu-list))) - (vhdl-menu-split menu-list "Project")) - '("--" "--" - ["Select Project..." vhdl-set-project t] - ["Set As Default Project" vhdl-set-default-project t] - "--" - ["Duplicate Project" vhdl-duplicate-project vhdl-project] - ["Import Project..." vhdl-import-project - :keys "C-c C-p C-m" :active t] - ["Export Project" vhdl-export-project vhdl-project] - "--" - ["Customize Project..." (customize-option 'vhdl-project-alist) t])) - "--" - ("Compile" - ["Compile Buffer" vhdl-compile t] - ["Stop Compilation" kill-compilation t] - "--" - ["Make" vhdl-make t] - ["Generate Makefile" vhdl-generate-makefile t] - "--" - ["Next Error" next-error t] - ["Previous Error" previous-error t] - ["First Error" first-error t] - "--" - ,(append - '("Compiler") - ;; add menu entries for defined compilers - (let ((comp-alist vhdl-compiler-alist) menu-list name) - (while comp-alist - (setq name (caar comp-alist)) - (setq menu-list - (cons `[,name (setq vhdl-compiler ,name) - :style radio :selected (equal ,name vhdl-compiler)] - menu-list)) - (setq comp-alist (cdr comp-alist))) - (setq menu-list (nreverse menu-list)) - (vhdl-menu-split menu-list "Compiler")) - '("--" "--" - ["Select Compiler..." vhdl-set-compiler t] - "--" - ["Customize Compiler..." - (customize-option 'vhdl-compiler-alist) t]))) - "--" - ,(append - '("Template" - ("VHDL Construct 1" - ["Alias" vhdl-template-alias t] - ["Architecture" vhdl-template-architecture t] - ["Assert" vhdl-template-assert t] - ["Attribute (Decl)" vhdl-template-attribute-decl t] - ["Attribute (Spec)" vhdl-template-attribute-spec t] - ["Block" vhdl-template-block t] - ["Case" vhdl-template-case-is t] - ["Component (Decl)" vhdl-template-component-decl t] - ["(Component) Instance" vhdl-template-component-inst t] - ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] - ["Configuration (Block)" vhdl-template-block-configuration t] - ["Configuration (Comp)" vhdl-template-component-conf t] - ["Configuration (Decl)" vhdl-template-configuration-decl t] - ["Configuration (Spec)" vhdl-template-configuration-spec t] - ["Constant" vhdl-template-constant t] - ["Context" vhdl-template-context t] - ["Disconnect" vhdl-template-disconnect t] - ["Else" vhdl-template-else t] - ["Elsif" vhdl-template-elsif t] - ["Entity" vhdl-template-entity t] - ["Exit" vhdl-template-exit t] - ["File" vhdl-template-file t] - ["For (Generate)" vhdl-template-for-generate t] - ["For (Loop)" vhdl-template-for-loop t] - ["Function (Body)" vhdl-template-function-body t] - ["Function (Decl)" vhdl-template-function-decl t] - ["Generic" vhdl-template-generic t] - ["Group (Decl)" vhdl-template-group-decl t] - ["Group (Template)" vhdl-template-group-template t]) - ("VHDL Construct 2" - ["If (Generate)" vhdl-template-if-generate t] - ["If (Then)" vhdl-template-if-then t] - ["Library" vhdl-template-library t] - ["Loop" vhdl-template-bare-loop t] - ["Map" vhdl-template-map t] - ["Next" vhdl-template-next t] - ["Others (Aggregate)" vhdl-template-others t] - ["Package (Decl)" vhdl-template-package-decl t] - ["Package (Body)" vhdl-template-package-body t] - ["Port" vhdl-template-port t] - ["Procedure (Body)" vhdl-template-procedure-body t] - ["Procedure (Decl)" vhdl-template-procedure-decl t] - ["Process (Comb)" vhdl-template-process-comb t] - ["Process (Seq)" vhdl-template-process-seq t] - ["Report" vhdl-template-report t] - ["Return" vhdl-template-return t] - ["Select" vhdl-template-selected-signal-asst t] - ["Signal" vhdl-template-signal t] - ["Subtype" vhdl-template-subtype t] - ["Type" vhdl-template-type t] - ["Use" vhdl-template-use t] - ["Variable" vhdl-template-variable t] - ["Wait" vhdl-template-wait t] - ["(Clocked Wait)" vhdl-template-clocked-wait t] - ["When" vhdl-template-when t] - ["While (Loop)" vhdl-template-while-loop t] - ["With" vhdl-template-with t])) - (when (vhdl-standard-p 'ams) - '(("VHDL-AMS Construct" - ["Break" vhdl-template-break t] - ["Case (Use)" vhdl-template-case-use t] - ["If (Use)" vhdl-template-if-use t] - ["Limit" vhdl-template-limit t] - ["Nature" vhdl-template-nature t] - ["Procedural" vhdl-template-procedural t] - ["Quantity (Free)" vhdl-template-quantity-free t] - ["Quantity (Branch)" vhdl-template-quantity-branch t] - ["Quantity (Source)" vhdl-template-quantity-source t] - ["Subnature" vhdl-template-subnature t] - ["Terminal" vhdl-template-terminal t]))) - '(["Insert Construct..." vhdl-template-insert-construct - :keys "C-c C-i C-t"] - "--") - (list - (append - '("Package") - '(["numeric_bit" vhdl-template-package-numeric-bit t] - ["numeric_std" vhdl-template-package-numeric-std t] - ["std_logic_1164" vhdl-template-package-std-logic-1164 t] - ["textio" vhdl-template-package-textio t] - "--" - ["std_logic_arith" vhdl-template-package-std-logic-arith t] - ["std_logic_signed" vhdl-template-package-std-logic-signed t] - ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] - ["std_logic_misc" vhdl-template-package-std-logic-misc t] - ["std_logic_textio" vhdl-template-package-std-logic-textio t] - "--") - (when (vhdl-standard-p 'ams) - '(["fundamental_constants" vhdl-template-package-fundamental-constants t] - ["material_constants" vhdl-template-package-material-constants t] - ["energy_systems" vhdl-template-package-energy-systems t] - ["electrical_systems" vhdl-template-package-electrical-systems t] - ["mechanical_systems" vhdl-template-package-mechanical-systems t] - ["radiant_systems" vhdl-template-package-radiant-systems t] - ["thermal_systems" vhdl-template-package-thermal-systems t] - ["fluidic_systems" vhdl-template-package-fluidic-systems t] - "--")) - (when (vhdl-standard-p 'math) - '(["math_complex" vhdl-template-package-math-complex t] - ["math_real" vhdl-template-package-math-real t] - "--")) - '(["Insert Package..." vhdl-template-insert-package - :keys "C-c C-i C-p"]))) - '(("Directive" - ["translate_on" vhdl-template-directive-translate-on t] - ["translate_off" vhdl-template-directive-translate-off t] - ["synthesis_on" vhdl-template-directive-synthesis-on t] - ["synthesis_off" vhdl-template-directive-synthesis-off t] - "--" - ["Insert Directive..." vhdl-template-insert-directive - :keys "C-c C-i C-d"]) - "--" - ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] - ["Insert Footer" vhdl-template-footer t] - ["Insert Date" vhdl-template-insert-date t] - ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] - "--" - ["Query Next Prompt" vhdl-template-search-prompt t])) - ,(append - '("Model") - ;; add menu entries for defined models - (let ((model-alist vhdl-model-alist) menu-list model) - (while model-alist - (setq model (car model-alist)) - (setq menu-list - (cons - (vector - (nth 0 model) - (vhdl-function-name "vhdl-model" (nth 0 model)) - :keys (concat "C-c C-m " (key-description (nth 2 model)))) - menu-list)) - (setq model-alist (cdr model-alist))) - (setq menu-list (nreverse menu-list)) - (vhdl-menu-split menu-list "Model")) - '("--" "--" - ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] - ["Customize Model..." (customize-option 'vhdl-model-alist) t])) - ("Port" - ["Copy" vhdl-port-copy t] - "--" - ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] - ["Paste As Component" vhdl-port-paste-component vhdl-port-list] - ["Paste As Instance" vhdl-port-paste-instance - :keys "C-c C-p C-i" :active vhdl-port-list] - ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] - ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] - ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] - ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] - "--" - ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] - "--" - ["Flatten" vhdl-port-flatten - :style toggle :selected vhdl-port-flattened :active vhdl-port-list] - ["Reverse Direction" vhdl-port-reverse-direction - :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) - ("Compose" - ["New Component" vhdl-compose-new-component t] - ["Copy Component" vhdl-port-copy t] - ["Place Component" vhdl-compose-place-component vhdl-port-list] - ["Wire Components" vhdl-compose-wire-components t] - "--" - ["Generate Configuration" vhdl-compose-configuration t] - ["Generate Components Package" vhdl-compose-components-package t]) - ("Subprogram" - ["Copy" vhdl-subprog-copy t] - "--" - ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] - ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] - ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] - "--" - ["Flatten" vhdl-subprog-flatten - :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) - "--" - ("Comment" - ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] - "--" - ["Insert Inline Comment" vhdl-comment-append-inline t] - ["Insert Horizontal Line" vhdl-comment-display-line t] - ["Insert Display Comment" vhdl-comment-display t] - "--" - ["Fill Comment" fill-paragraph t] - ["Fill Comment Region" fill-region (mark)] - ["Kill Comment Region" vhdl-comment-kill-region (mark)] - ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) - ("Line" - ["Kill" vhdl-line-kill t] - ["Copy" vhdl-line-copy t] - ["Yank" vhdl-line-yank t] - ["Expand" vhdl-line-expand t] - "--" - ["Transpose Next" vhdl-line-transpose-next t] - ["Transpose Prev" vhdl-line-transpose-previous t] - ["Open" vhdl-line-open t] - ["Join" vhdl-delete-indentation t] - "--" - ["Goto" goto-line t] - ["(Un)Comment Out" vhdl-comment-uncomment-line t]) - ("Move" - ["Forward Statement" vhdl-end-of-statement t] - ["Backward Statement" vhdl-beginning-of-statement t] - ["Forward Expression" vhdl-forward-sexp t] - ["Backward Expression" vhdl-backward-sexp t] - ["Forward Same Indent" vhdl-forward-same-indent t] - ["Backward Same Indent" vhdl-backward-same-indent t] - ["Forward Function" vhdl-end-of-defun t] - ["Backward Function" vhdl-beginning-of-defun t] - ["Mark Function" vhdl-mark-defun t]) - "--" - ("Indent" - ["Line" indent-according-to-mode :keys "C-c C-i C-l"] - ["Group" vhdl-indent-group :keys "C-c C-i C-g"] - ["Region" indent-region (mark)] - ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) - ("Align" - ["Group" vhdl-align-group t] - ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] - ["List" vhdl-align-list t] - ["Declarations" vhdl-align-declarations t] - ["Region" vhdl-align-region (mark)] - ["Buffer" vhdl-align-buffer t] - "--" - ["Inline Comment Group" vhdl-align-inline-comment-group t] - ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] - ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) - ("Fill" - ["List" vhdl-fill-list t] - ["Group" vhdl-fill-group t] - ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] - ["Region" vhdl-fill-region (mark)]) - ("Beautify" - ["Region" vhdl-beautify-region (mark)] - ["Buffer" vhdl-beautify-buffer t]) - ("Fix" - ["Generic/Port Clause" vhdl-fix-clause t] - ["Generic/Port Clause Buffer" vhdl-fix-clause t] - "--" - ["Case Region" vhdl-fix-case-region (mark)] - ["Case Buffer" vhdl-fix-case-buffer t] - "--" - ["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] - ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) - "--" - ["Fontify Buffer" vhdl-fontify-buffer t] - ["Statistics Buffer" vhdl-statistics-buffer t] - ["Show Messages" vhdl-show-messages t] - ["Syntactic Info" vhdl-show-syntactic-information t] - "--" - ["Speedbar" vhdl-speedbar t] - ["Hide/Show" vhdl-hs-minor-mode t] - "--" - ("Documentation" - ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] - ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] - ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] - ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) - ["Version" vhdl-version t] - ["Bug Report..." vhdl-submit-bug-report t] - "--" - ("Options" - ("Mode" - ["Electric Mode" - (progn (customize-set-variable 'vhdl-electric-mode - (not vhdl-electric-mode)) - (vhdl-mode-line-update)) - :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] - ["Stutter Mode" - (progn (customize-set-variable 'vhdl-stutter-mode - (not vhdl-stutter-mode)) - (vhdl-mode-line-update)) - :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] - ["Indent Tabs Mode" - (progn (customize-set-variable 'vhdl-indent-tabs-mode - (not vhdl-indent-tabs-mode)) - (setq indent-tabs-mode vhdl-indent-tabs-mode)) - :style toggle :selected vhdl-indent-tabs-mode] - "--" - ["Customize Group..." (customize-group 'vhdl-mode) t]) - ("Project" - ["Project Setup..." (customize-option 'vhdl-project-alist) t] - ,(append - '("Selected Project at Startup" - ["None" (progn (customize-set-variable 'vhdl-project nil) - (vhdl-set-project "")) - :style radio :selected (null vhdl-project)] - "--") - ;; add menu entries for defined projects - (let ((project-alist vhdl-project-alist) menu-list name) - (while project-alist - (setq name (caar project-alist)) - (setq menu-list - (cons `[,name (progn (customize-set-variable - 'vhdl-project ,name) - (vhdl-set-project ,name)) - :style radio :selected (equal ,name vhdl-project)] - menu-list)) - (setq project-alist (cdr project-alist))) - (setq menu-list (nreverse menu-list)) - (vhdl-menu-split menu-list "Project"))) - ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] - ("Auto Load Setup File" - ["At Startup" - (customize-set-variable 'vhdl-project-autoload - (if (memq 'startup vhdl-project-autoload) - (delq 'startup vhdl-project-autoload) - (cons 'startup vhdl-project-autoload))) - :style toggle :selected (memq 'startup vhdl-project-autoload)]) - ["Sort Projects" - (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) - :style toggle :selected vhdl-project-sort] - "--" - ["Customize Group..." (customize-group 'vhdl-project) t]) - ("Compiler" - ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] - ,(append - '("Selected Compiler at Startup") - ;; add menu entries for defined compilers - (let ((comp-alist vhdl-compiler-alist) menu-list name) - (while comp-alist - (setq name (caar comp-alist)) - (setq menu-list - (cons `[,name (customize-set-variable 'vhdl-compiler ,name) - :style radio :selected (equal ,name vhdl-compiler)] - menu-list)) - (setq comp-alist (cdr comp-alist))) - (setq menu-list (nreverse menu-list)) - (vhdl-menu-split menu-list "Compiler"))) - ["Use Local Error Regexp" - (customize-set-variable 'vhdl-compile-use-local-error-regexp - (not vhdl-compile-use-local-error-regexp)) - :style toggle :selected vhdl-compile-use-local-error-regexp] - ["Makefile Default Targets..." - (customize-option 'vhdl-makefile-default-targets) t] - ["Makefile Generation Hook..." - (customize-option 'vhdl-makefile-generation-hook) t] - ["Default Library Name" (customize-option 'vhdl-default-library) t] - "--" - ["Customize Group..." (customize-group 'vhdl-compiler) t]) - ("Style" - ("VHDL Standard" - ["VHDL'87" - (progn (customize-set-variable 'vhdl-standard - (list '87 (cadr vhdl-standard))) - (vhdl-activate-customizations)) - :style radio :selected (eq '87 (car vhdl-standard))] - ["VHDL'93/02" - (progn (customize-set-variable 'vhdl-standard - (list '93 (cadr vhdl-standard))) - (vhdl-activate-customizations)) - :style radio :selected (eq '93 (car vhdl-standard))] - ["VHDL'08" - (progn (customize-set-variable 'vhdl-standard - (list '08 (cadr vhdl-standard))) - (vhdl-activate-customizations)) - :style radio :selected (eq '08 (car vhdl-standard))] - "--" - ["VHDL-AMS" - (progn (customize-set-variable - 'vhdl-standard (list (car vhdl-standard) - (if (memq 'ams (cadr vhdl-standard)) - (delq 'ams (cadr vhdl-standard)) - (cons 'ams (cadr vhdl-standard))))) - (vhdl-activate-customizations)) - :style toggle :selected (memq 'ams (cadr vhdl-standard))] - ["Math Packages" - (progn (customize-set-variable - 'vhdl-standard (list (car vhdl-standard) - (if (memq 'math (cadr vhdl-standard)) - (delq 'math (cadr vhdl-standard)) - (cons 'math (cadr vhdl-standard))))) - (vhdl-activate-customizations)) - :style toggle :selected (memq 'math (cadr vhdl-standard))]) - ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] - ["Upper Case Keywords" - (customize-set-variable 'vhdl-upper-case-keywords - (not vhdl-upper-case-keywords)) - :style toggle :selected vhdl-upper-case-keywords] - ["Upper Case Types" - (customize-set-variable 'vhdl-upper-case-types - (not vhdl-upper-case-types)) - :style toggle :selected vhdl-upper-case-types] - ["Upper Case Attributes" - (customize-set-variable 'vhdl-upper-case-attributes - (not vhdl-upper-case-attributes)) - :style toggle :selected vhdl-upper-case-attributes] - ["Upper Case Enumeration Values" - (customize-set-variable 'vhdl-upper-case-enum-values - (not vhdl-upper-case-enum-values)) - :style toggle :selected vhdl-upper-case-enum-values] - ["Upper Case Constants" - (customize-set-variable 'vhdl-upper-case-constants - (not vhdl-upper-case-constants)) - :style toggle :selected vhdl-upper-case-constants] - ("Use Direct Instantiation" - ["Never" - (customize-set-variable 'vhdl-use-direct-instantiation 'never) - :style radio :selected (eq 'never vhdl-use-direct-instantiation)] - ["Standard" - (customize-set-variable 'vhdl-use-direct-instantiation 'standard) - :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] - ["Always" - (customize-set-variable 'vhdl-use-direct-instantiation 'always) - :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) - ["Include Array Index and Record Field in Sensitivity List" - (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list - (not vhdl-array-index-record-field-in-sensitivity-list)) - :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list] - "--" - ["Customize Group..." (customize-group 'vhdl-style) t]) - ("Naming" - ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] - ["Architecture File Name..." - (customize-option 'vhdl-architecture-file-name) t] - ["Configuration File Name..." - (customize-option 'vhdl-configuration-file-name) t] - ["Package File Name..." (customize-option 'vhdl-package-file-name) t] - ("File Name Case" - ["As Is" - (customize-set-variable 'vhdl-file-name-case 'identity) - :style radio :selected (eq 'identity vhdl-file-name-case)] - ["Lower Case" - (customize-set-variable 'vhdl-file-name-case 'downcase) - :style radio :selected (eq 'downcase vhdl-file-name-case)] - ["Upper Case" - (customize-set-variable 'vhdl-file-name-case 'upcase) - :style radio :selected (eq 'upcase vhdl-file-name-case)] - ["Capitalize" - (customize-set-variable 'vhdl-file-name-case 'capitalize) - :style radio :selected (eq 'capitalize vhdl-file-name-case)]) - "--" - ["Customize Group..." (customize-group 'vhdl-naming) t]) - ("Template" - ("Electric Keywords" - ["VHDL Keywords" - (customize-set-variable 'vhdl-electric-keywords - (if (memq 'vhdl vhdl-electric-keywords) - (delq 'vhdl vhdl-electric-keywords) - (cons 'vhdl vhdl-electric-keywords))) - :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] - ["User Model Keywords" - (customize-set-variable 'vhdl-electric-keywords - (if (memq 'user vhdl-electric-keywords) - (delq 'user vhdl-electric-keywords) - (cons 'user vhdl-electric-keywords))) - :style toggle :selected (memq 'user vhdl-electric-keywords)]) - ("Insert Optional Labels" - ["None" - (customize-set-variable 'vhdl-optional-labels 'none) - :style radio :selected (eq 'none vhdl-optional-labels)] - ["Processes Only" - (customize-set-variable 'vhdl-optional-labels 'process) - :style radio :selected (eq 'process vhdl-optional-labels)] - ["All Constructs" - (customize-set-variable 'vhdl-optional-labels 'all) - :style radio :selected (eq 'all vhdl-optional-labels)]) - ("Insert Empty Lines" - ["None" - (customize-set-variable 'vhdl-insert-empty-lines 'none) - :style radio :selected (eq 'none vhdl-insert-empty-lines)] - ["Design Units Only" - (customize-set-variable 'vhdl-insert-empty-lines 'unit) - :style radio :selected (eq 'unit vhdl-insert-empty-lines)] - ["All Constructs" - (customize-set-variable 'vhdl-insert-empty-lines 'all) - :style radio :selected (eq 'all vhdl-insert-empty-lines)]) - ["Argument List Indent" - (customize-set-variable 'vhdl-argument-list-indent - (not vhdl-argument-list-indent)) - :style toggle :selected vhdl-argument-list-indent] - ["Association List with Formals" - (customize-set-variable 'vhdl-association-list-with-formals - (not vhdl-association-list-with-formals)) - :style toggle :selected vhdl-association-list-with-formals] - ["Conditions in Parenthesis" - (customize-set-variable 'vhdl-conditions-in-parenthesis - (not vhdl-conditions-in-parenthesis)) - :style toggle :selected vhdl-conditions-in-parenthesis] - ["Sensitivity List uses 'all'" - (customize-set-variable 'vhdl-sensitivity-list-all - (not vhdl-sensitivity-list-all)) - :style toggle :selected vhdl-sensitivity-list-all] - ["Zero String..." (customize-option 'vhdl-zero-string) t] - ["One String..." (customize-option 'vhdl-one-string) t] - ("File Header" - ["Header String..." (customize-option 'vhdl-file-header) t] - ["Footer String..." (customize-option 'vhdl-file-footer) t] - ["Company Name..." (customize-option 'vhdl-company-name) t] - ["Copyright String..." (customize-option 'vhdl-copyright-string) t] - ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] - ["Date Format..." (customize-option 'vhdl-date-format) t] - ["Modify Date Prefix String..." - (customize-option 'vhdl-modify-date-prefix-string) t] - ["Modify Date on Saving" - (progn (customize-set-variable 'vhdl-modify-date-on-saving - (not vhdl-modify-date-on-saving)) - (vhdl-activate-customizations)) - :style toggle :selected vhdl-modify-date-on-saving]) - ("Sequential Process" - ("Kind of Reset" - ["None" - (customize-set-variable 'vhdl-reset-kind 'none) - :style radio :selected (eq 'none vhdl-reset-kind)] - ["Synchronous" - (customize-set-variable 'vhdl-reset-kind 'sync) - :style radio :selected (eq 'sync vhdl-reset-kind)] - ["Asynchronous" - (customize-set-variable 'vhdl-reset-kind 'async) - :style radio :selected (eq 'async vhdl-reset-kind)] - ["Query" - (customize-set-variable 'vhdl-reset-kind 'query) - :style radio :selected (eq 'query vhdl-reset-kind)]) - ["Reset is Active High" - (customize-set-variable 'vhdl-reset-active-high - (not vhdl-reset-active-high)) - :style toggle :selected vhdl-reset-active-high] - ["Use Rising Clock Edge" - (customize-set-variable 'vhdl-clock-rising-edge - (not vhdl-clock-rising-edge)) - :style toggle :selected vhdl-clock-rising-edge] - ("Clock Edge Condition" - ["Standard" - (customize-set-variable 'vhdl-clock-edge-condition 'standard) - :style radio :selected (eq 'standard vhdl-clock-edge-condition)] - ["Function \"rising_edge\"" - (customize-set-variable 'vhdl-clock-edge-condition 'function) - :style radio :selected (eq 'function vhdl-clock-edge-condition)]) - ["Clock Name..." (customize-option 'vhdl-clock-name) t] - ["Reset Name..." (customize-option 'vhdl-reset-name) t]) - "--" - ["Customize Group..." (customize-group 'vhdl-template) t]) - ("Model" - ["Model Definition..." (customize-option 'vhdl-model-alist) t]) - ("Port" - ["Include Port Comments" - (customize-set-variable 'vhdl-include-port-comments - (not vhdl-include-port-comments)) - :style toggle :selected vhdl-include-port-comments] - ["Include Direction Comments" - (customize-set-variable 'vhdl-include-direction-comments - (not vhdl-include-direction-comments)) - :style toggle :selected vhdl-include-direction-comments] - ["Include Type Comments" - (customize-set-variable 'vhdl-include-type-comments - (not vhdl-include-type-comments)) - :style toggle :selected vhdl-include-type-comments] - ("Include Group Comments" - ["Never" - (customize-set-variable 'vhdl-include-group-comments 'never) - :style radio :selected (eq 'never vhdl-include-group-comments)] - ["Declarations" - (customize-set-variable 'vhdl-include-group-comments 'decl) - :style radio :selected (eq 'decl vhdl-include-group-comments)] - ["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" - ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] - ["Architecture Name..." - (customize-option 'vhdl-testbench-architecture-name) t] - ["Configuration Name..." - (customize-option 'vhdl-testbench-configuration-name) t] - ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] - ["Include Header" - (customize-set-variable 'vhdl-testbench-include-header - (not vhdl-testbench-include-header)) - :style toggle :selected vhdl-testbench-include-header] - ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] - ["Statements..." (customize-option 'vhdl-testbench-statements) t] - ["Initialize Signals" - (customize-set-variable 'vhdl-testbench-initialize-signals - (not vhdl-testbench-initialize-signals)) - :style toggle :selected vhdl-testbench-initialize-signals] - ["Include Library Clause" - (customize-set-variable 'vhdl-testbench-include-library - (not vhdl-testbench-include-library)) - :style toggle :selected vhdl-testbench-include-library] - ["Include Configuration" - (customize-set-variable 'vhdl-testbench-include-configuration - (not vhdl-testbench-include-configuration)) - :style toggle :selected vhdl-testbench-include-configuration] - ("Create Files" - ["None" - (customize-set-variable 'vhdl-testbench-create-files 'none) - :style radio :selected (eq 'none vhdl-testbench-create-files)] - ["Single" - (customize-set-variable 'vhdl-testbench-create-files 'single) - :style radio :selected (eq 'single vhdl-testbench-create-files)] - ["Separate" - (customize-set-variable 'vhdl-testbench-create-files 'separate) - :style radio :selected (eq 'separate vhdl-testbench-create-files)]) - ["Testbench Entity File Name..." - (customize-option 'vhdl-testbench-entity-file-name) t] - ["Testbench Architecture File Name..." - (customize-option 'vhdl-testbench-architecture-file-name) t]) - "--" - ["Customize Group..." (customize-group 'vhdl-port) t]) - ("Compose" - ["Architecture Name..." - (customize-option 'vhdl-compose-architecture-name) t] - ["Configuration Name..." - (customize-option 'vhdl-compose-configuration-name) t] - ["Components Package Name..." - (customize-option 'vhdl-components-package-name) t] - ["Use Components Package" - (customize-set-variable 'vhdl-use-components-package - (not vhdl-use-components-package)) - :style toggle :selected vhdl-use-components-package] - ["Include Header" - (customize-set-variable 'vhdl-compose-include-header - (not vhdl-compose-include-header)) - :style toggle :selected vhdl-compose-include-header] - ("Create Entity/Architecture Files" - ["None" - (customize-set-variable 'vhdl-compose-create-files 'none) - :style radio :selected (eq 'none vhdl-compose-create-files)] - ["Single" - (customize-set-variable 'vhdl-compose-create-files 'single) - :style radio :selected (eq 'single vhdl-compose-create-files)] - ["Separate" - (customize-set-variable 'vhdl-compose-create-files 'separate) - :style radio :selected (eq 'separate vhdl-compose-create-files)]) - ["Create Configuration File" - (customize-set-variable 'vhdl-compose-configuration-create-file - (not vhdl-compose-configuration-create-file)) - :style toggle :selected vhdl-compose-configuration-create-file] - ["Hierarchical Configuration" - (customize-set-variable 'vhdl-compose-configuration-hierarchical - (not vhdl-compose-configuration-hierarchical)) - :style toggle :selected vhdl-compose-configuration-hierarchical] - ["Use Subconfiguration" - (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration - (not vhdl-compose-configuration-use-subconfiguration)) - :style toggle :selected vhdl-compose-configuration-use-subconfiguration] - "--" - ["Customize Group..." (customize-group 'vhdl-compose) t]) - ("Comment" - ["Self Insert Comments" - (customize-set-variable 'vhdl-self-insert-comments - (not vhdl-self-insert-comments)) - :style toggle :selected vhdl-self-insert-comments] - ["Prompt for Comments" - (customize-set-variable 'vhdl-prompt-for-comments - (not vhdl-prompt-for-comments)) - :style toggle :selected vhdl-prompt-for-comments] - ["Inline Comment Column..." - (customize-option 'vhdl-inline-comment-column) t] - ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] - "--" - ["Customize Group..." (customize-group 'vhdl-comment) t]) - ("Beautify" - ["Auto Align Templates" - (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) - :style toggle :selected vhdl-auto-align] - ["Align Line Groups" - (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) - :style toggle :selected vhdl-align-groups] - ["Group Separation String..." - (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-beautify) t]) - ("Highlight" - ["Highlighting On/Off..." - (customize-option - (if (fboundp 'global-font-lock-mode) - 'global-font-lock-mode 'font-lock-auto-fontify)) t] - ["Highlight Keywords" - (progn (customize-set-variable 'vhdl-highlight-keywords - (not vhdl-highlight-keywords)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-keywords] - ["Highlight Names" - (progn (customize-set-variable 'vhdl-highlight-names - (not vhdl-highlight-names)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-names] - ["Highlight Special Words" - (progn (customize-set-variable 'vhdl-highlight-special-words - (not vhdl-highlight-special-words)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-special-words] - ["Highlight Forbidden Words" - (progn (customize-set-variable 'vhdl-highlight-forbidden-words - (not vhdl-highlight-forbidden-words)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-forbidden-words] - ["Highlight Verilog Keywords" - (progn (customize-set-variable 'vhdl-highlight-verilog-keywords - (not vhdl-highlight-verilog-keywords)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-verilog-keywords] - ["Highlight \"translate_off\"" - (progn (customize-set-variable 'vhdl-highlight-translate-off - (not vhdl-highlight-translate-off)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-translate-off] - ["Case Sensitive Highlighting" - (progn (customize-set-variable 'vhdl-highlight-case-sensitive - (not vhdl-highlight-case-sensitive)) - (vhdl-fontify-buffer)) - :style toggle :selected vhdl-highlight-case-sensitive] - ["Special Syntax Definition..." - (customize-option 'vhdl-special-syntax-alist) t] - ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] - ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] - ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] - ["Colors..." (customize-group 'vhdl-highlight-faces) t] - "--" - ["Customize Group..." (customize-group 'vhdl-highlight) t]) - ("Speedbar" - ["Auto Open at Startup" - (customize-set-variable 'vhdl-speedbar-auto-open - (not vhdl-speedbar-auto-open)) - :style toggle :selected vhdl-speedbar-auto-open] - ("Default Displaying Mode" - ["Files" - (customize-set-variable 'vhdl-speedbar-display-mode 'files) - :style radio :selected (eq 'files vhdl-speedbar-display-mode)] - ["Directory Hierarchy" - (customize-set-variable 'vhdl-speedbar-display-mode 'directory) - :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] - ["Project Hierarchy" - (customize-set-variable 'vhdl-speedbar-display-mode 'project) - :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) - ["Indentation Offset..." - (customize-option 'speedbar-indentation-width) t] - ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] - ["Jump to Unit when Opening" - (customize-set-variable 'vhdl-speedbar-jump-to-unit - (not vhdl-speedbar-jump-to-unit)) - :style toggle :selected vhdl-speedbar-jump-to-unit] - ["Update Hierarchy on File Saving" - (customize-set-variable 'vhdl-speedbar-update-on-saving - (not vhdl-speedbar-update-on-saving)) - :style toggle :selected vhdl-speedbar-update-on-saving] - ("Save in Cache File" - ["Hierarchy Information" - (customize-set-variable 'vhdl-speedbar-save-cache - (if (memq 'hierarchy vhdl-speedbar-save-cache) - (delq 'hierarchy vhdl-speedbar-save-cache) - (cons 'hierarchy vhdl-speedbar-save-cache))) - :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] - ["Displaying Status" - (customize-set-variable 'vhdl-speedbar-save-cache - (if (memq 'display vhdl-speedbar-save-cache) - (delq 'display vhdl-speedbar-save-cache) - (cons 'display vhdl-speedbar-save-cache))) - :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) - ["Cache File Name..." - (customize-option 'vhdl-speedbar-cache-file-name) t] - "--" - ["Customize Group..." (customize-group 'vhdl-speedbar) t]) - ("Menu" - ["Add Index Menu when Loading File" - (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) - (vhdl-index-menu-init)) - :style toggle :selected vhdl-index-menu] - ["Add Source File Menu when Loading File" - (progn (customize-set-variable 'vhdl-source-file-menu - (not vhdl-source-file-menu)) - (vhdl-add-source-files-menu)) - :style toggle :selected vhdl-source-file-menu] - ["Add Hideshow Menu at Startup" - (progn (customize-set-variable 'vhdl-hideshow-menu - (not vhdl-hideshow-menu)) - (vhdl-activate-customizations)) - :style toggle :selected vhdl-hideshow-menu] - ["Hide Everything Initially" - (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) - :style toggle :selected vhdl-hide-all-init] - "--" - ["Customize Group..." (customize-group 'vhdl-menu) t]) - ("Print" - ["In Two Column Format" - (progn (customize-set-variable 'vhdl-print-two-column - (not vhdl-print-two-column)) - (message "Activate new setting by saving options and restarting Emacs")) - :style toggle :selected vhdl-print-two-column] - ["Use Customized Faces" - (progn (customize-set-variable 'vhdl-print-customize-faces - (not vhdl-print-customize-faces)) - (message "Activate new setting by saving options and restarting Emacs")) - :style toggle :selected vhdl-print-customize-faces] - "--" - ["Customize Group..." (customize-group 'vhdl-print) t]) - ("Miscellaneous" - ["Use Intelligent Tab" - (progn (customize-set-variable 'vhdl-intelligent-tab - (not vhdl-intelligent-tab)) - (vhdl-activate-customizations)) - :style toggle :selected vhdl-intelligent-tab] - ["Indent Syntax-Based" - (customize-set-variable 'vhdl-indent-syntax-based - (not vhdl-indent-syntax-based)) - :style toggle :selected vhdl-indent-syntax-based] - ["Indent Comments Like Next Code Line" - (customize-set-variable 'vhdl-indent-comment-like-next-code-line - (not vhdl-indent-comment-like-next-code-line)) - :style toggle :selected vhdl-indent-comment-like-next-code-line] - ["Word Completion is Case Sensitive" - (customize-set-variable 'vhdl-word-completion-case-sensitive - (not vhdl-word-completion-case-sensitive)) - :style toggle :selected vhdl-word-completion-case-sensitive] - ["Word Completion in Minibuffer" - (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer - (not vhdl-word-completion-in-minibuffer)) - (message "Activate new setting by saving options and restarting Emacs")) - :style toggle :selected vhdl-word-completion-in-minibuffer] - ["Underscore is Part of Word" - (progn (customize-set-variable 'vhdl-underscore-is-part-of-word - (not vhdl-underscore-is-part-of-word)) - (vhdl-activate-customizations)) - :style toggle :selected vhdl-underscore-is-part-of-word] - "--" - ["Customize Group..." (customize-group 'vhdl-misc) t]) - ["Related..." (customize-browse 'vhdl-related) t] - "--" - ["Save Options" customize-save-customized t] - ["Activate Options" vhdl-activate-customizations t] - ["Browse Options..." vhdl-customize t]))) - -(defvar vhdl-mode-menu-list (vhdl-create-mode-menu) - "VHDL Mode menu.") - -(defun vhdl-update-mode-menu () - "Update VHDL Mode menu." - (interactive) - (when (featurep 'xemacs) - (easy-menu-remove vhdl-mode-menu-list)) - (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) - (when (featurep 'xemacs) - (easy-menu-add vhdl-mode-menu-list)) - (easy-menu-define vhdl-mode-menu vhdl-mode-map - "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') - -(defconst vhdl-imenu-generic-expression - '( - ("Subprogram" - "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" - 4) - ("Instance" - "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" - 1) - ("Component" - "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" - 2) - ("Procedural" - "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" - 1) - ("Process" - "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" - 1) - ("Block" - "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" - 1) - ("Package" - "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" - 3) - ("Configuration" - "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" - 2) - ("Architecture" - "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" - 2) - ("Entity" - "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" - 2) - ("Context" - "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" - 2) - ) - "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") - -(defun vhdl-index-menu-init () - "Initialize index menu." - (set (make-local-variable 'imenu-case-fold-search) t) - (set (make-local-variable 'imenu-generic-expression) - vhdl-imenu-generic-expression) - (when (and vhdl-index-menu (fboundp 'imenu)) - (imenu-add-to-menubar "Index"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Source file menu (using `easy-menu.el') - -(defvar vhdl-sources-menu nil) - -(defun vhdl-directory-files (directory &optional full match) - "Call `directory-files' if DIRECTORY exists, otherwise generate error message." - (if (not (file-directory-p directory)) - (vhdl-warning-when-idle "No such directory: \"%s\"" directory) - (let ((dir (directory-files directory full match))) - (setq dir (delete "." dir)) - (setq dir (delete ".." dir)) - dir))) - -(defun vhdl-get-source-files (&optional full directory) - "Get list of VHDL source files in DIRECTORY or current directory." - (let ((mode-alist auto-mode-alist) - filename-regexp) - ;; create regular expressions for matching file names - (setq filename-regexp "\\`[^.].*\\(") - (while mode-alist - (when (eq (cdar mode-alist) 'vhdl-mode) - (setq filename-regexp - (concat filename-regexp (caar mode-alist) "\\|"))) - (setq mode-alist (cdr mode-alist))) - (setq filename-regexp - (concat (substring filename-regexp 0 - (string-match "\\\\|$" filename-regexp)) "\\)")) - ;; find files - (vhdl-directory-files - (or directory default-directory) full filename-regexp))) - -(defun vhdl-add-source-files-menu () - "Scan directory for all VHDL source files and generate menu. -The directory of the current source file is scanned." - (interactive) - (message "Scanning directory for source files ...") - (let ((newmap (current-local-map)) - (file-list (vhdl-get-source-files)) - menu-list found) - ;; Create list for menu - (setq found nil) - (while file-list - (setq found t) - (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 (push "--" menu-list)) - (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) - (push "Sources" menu-list) - ;; Create menu - (when (featurep 'xemacs) - (easy-menu-add menu-list)) - (easy-menu-define vhdl-sources-menu newmap - "VHDL source files menu" menu-list)) - (message "")) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mode definition -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; performs all buffer local initializations - -;;;###autoload -(define-derived-mode vhdl-mode prog-mode - '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) - (vhdl-electric-mode "e") - (vhdl-stutter-mode "s")) - "Major mode for editing VHDL code. - -Usage: ------- - - TEMPLATE INSERTION (electrification): - After typing a VHDL keyword and entering `SPC', you are prompted for - arguments while a template is generated for that VHDL construct. Typing - `RET' or `C-g' at the first (mandatory) prompt aborts the current - template generation. Optional arguments are indicated by square - brackets and removed if the queried string is left empty. Prompts for - mandatory arguments remain in the code if the queried string is left - empty. They can be queried again by `C-c C-t C-q'. Enabled - electrification is indicated by `/e' in the mode line. - - Typing `M-SPC' after a keyword inserts a space without calling the - template generator. Automatic template generation (i.e. - electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by - setting option `vhdl-electric-mode' (see OPTIONS). - - Template generators can be invoked from the VHDL menu, by key - bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing - the keyword (i.e. first word of menu entry not in parenthesis) and - `SPC'. The following abbreviations can also be used: arch, attr, cond, - conf, comp, cons, func, inst, pack, sig, var. - - Template styles can be customized in customization group - `vhdl-template' (see OPTIONS). - - - HEADER INSERTION: - A file header can be inserted by `C-c C-t C-h'. A file footer - (template at the end of the file) can be inserted by `C-c C-t C-f'. - See customization group `vhdl-header'. - - - STUTTERING: - Double striking of some keys inserts cumbersome VHDL syntax elements. - Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by - option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in - the mode line. The stuttering keys and their effects are: - - ;; --> \" : \" [ --> ( -- --> comment - ;;; --> \" := \" [[ --> [ --CR --> comment-out code - .. --> \" => \" ] --> ) --- --> horizontal line - ,, --> \" <= \" ]] --> ] ---- --> display comment - == --> \" == \" \\='\\=' --> \\\" - - - WORD COMPLETION: - Typing `TAB' after a (not completed) word looks for a VHDL keyword or a - word in the buffer that starts alike, inserts it and adjusts case. - Re-typing `TAB' toggles through alternative word completions. This also - works in the minibuffer (i.e. in template generator prompts). - - Typing `TAB' after `(' looks for and inserts complete parenthesized - expressions (e.g. for array index ranges). All keywords as well as - standard types and subprograms of VHDL have predefined abbreviations - (e.g., type \"std\" and `TAB' will toggle through all standard types - beginning with \"std\"). - - Typing `TAB' after a non-word character indents the line if at the - beginning of a line (i.e. no preceding non-blank characters), and - inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator - stop. - - - COMMENTS: - `--' puts a single comment. - `---' draws a horizontal line for separating code segments. - `----' inserts a display comment, i.e. two horizontal lines - with a comment in between. - `--CR' comments out code on that line. Re-hitting CR comments - out following lines. - `C-c C-c' comments out a region if not commented out, - uncomments a region if already commented out. Option - `comment-style' defines where the comment characters - should be placed (beginning of line, indent, etc.). - - You are prompted for comments after object definitions (i.e. signals, - variables, constants, ports) and after subprogram and process - specifications if option `vhdl-prompt-for-comments' is non-nil. - Comments are automatically inserted as additional labels (e.g. after - begin statements) and as help comments if `vhdl-self-insert-comments' is - non-nil. - - Inline comments (i.e. comments after a piece of code on the same line) - are indented at least to `vhdl-inline-comment-column'. Comments go at - maximum to `vhdl-end-comment-column'. `RET' after a space in a comment - will open a new comment line. Typing beyond `vhdl-end-comment-column' - in a comment automatically opens a new comment line. `M-q' re-fills - multi-line comments. - - - INDENTATION: - `TAB' indents a line if at the beginning of the line. The amount of - indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' - always indents the current line (is bound to `TAB' if option - `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents - the entire region. - - Indentation can be done for a group of lines (`C-c C-i C-g'), a region - (`M-C-\\') or the entire buffer (menu). Argument and port lists are - indented normally (nil) or relative to the opening parenthesis (non-nil) - according to option `vhdl-argument-list-indent'. - - If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to - tabs and vice versa. - - Syntax-based indentation can be very slow in large files. Option - `vhdl-indent-syntax-based' allows you to use faster but simpler indentation. - - Option `vhdl-indent-comment-like-next-code-line' controls whether - comment lines are indented like the preceding or like the following code - line. - - - ALIGNMENT: - The alignment functions align operators, keywords, and inline comments - to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines - separated by blank lines, `C-c C-a C-i' a block of lines with same - indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by - a pair of parentheses (e.g. port clause/map, argument list), and `C-c - C-a C-d' all lines within the declarative part of a design unit. `C-c - C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments - for a group of lines, and `C-c C-a M-c' for a region. - - If option `vhdl-align-groups' is non-nil, groups of code lines - separated by special lines (see option `vhdl-align-group-separate') are - aligned individually. If option `vhdl-align-same-indent' is non-nil, - blocks of lines with same indent are aligned separately. Some templates - are automatically aligned after generation if option `vhdl-auto-align' - is non-nil. - - Alignment tries to align inline comments at - `vhdl-inline-comment-column' and tries inline comment not to exceed - `vhdl-end-comment-column'. - - `C-c C-x M-w' fixes up whitespace in a region. That is, operator - symbols are surrounded by one space, and multiple spaces are eliminated. - - - CODE FILLING: - Code filling allows you to condense code (e.g. sensitivity lists or port - maps) by removing comments and newlines and re-wrapping so that all - lines are maximally filled (block filling). `C-c C-f C-f' fills a list - enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by - blank lines, `C-c C-f C-i' a block of lines with same indent, and - `C-c C-f M-f' an entire region. - - - CODE BEAUTIFICATION: - `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire - buffer respectively. This includes indentation, alignment, and case - fixing. Code beautification can also be run non-interactively using the - command: - - emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer - - - PORT TRANSLATION: - Generic and port clauses from entity or component declarations can be - copied (`C-c C-p C-w') and pasted as entity and component declarations, - as component instantiations and corresponding internal constants and - signals, as a generic map with constants as actual generics, and as - internal signal initializations (menu). - - To include formals in component instantiations, see option - `vhdl-association-list-with-formals'. To include comments in pasting, - see options `vhdl-include-...-comments'. - - A clause with several generic/port names on the same line can be - flattened (`C-c C-p C-f') so that only one name per line exists. The - direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become - outputs and vice versa, which can be useful in testbenches. (This - reversion is done on the internal data structure and is only reflected - in subsequent paste operations.) - - Names for actual ports, instances, testbenches, and - design-under-test instances can be derived from existing names according - to options `vhdl-...-name'. See customization group `vhdl-port'. - - - SUBPROGRAM TRANSLATION: - Similar functionality exists for copying/pasting the interface of - subprograms (function/procedure). A subprogram interface can be copied - and then pasted as a subprogram declaration, body or call (uses - association list with formals). - - - TESTBENCH GENERATION: - A copied port can also be pasted as a testbench. The generated - testbench includes an entity, an architecture, and an optional - configuration. The architecture contains the component declaration and - instantiation of the DUT as well as internal constant and signal - declarations. Additional user-defined templates can be inserted. The - names used for entity/architecture/configuration/DUT as well as the file - structure to be generated can be customized. See customization group - `vhdl-testbench'. - - - KEY BINDINGS: - Key bindings (`C-c ...') exist for most commands (see in menu). - - - VHDL MENU: - All commands can be found in the VHDL menu including their key bindings. - - - FILE BROWSER: - The speedbar allows browsing of directories and file contents. It can - be accessed from the VHDL menu and is automatically opened if option - `vhdl-speedbar-auto-open' is non-nil. - - In speedbar, open files and directories with `mouse-2' on the name and - browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. - - - DESIGN HIERARCHY BROWSER: - The speedbar can also be used for browsing the hierarchy of design units - contained in the source files of the current directory or the specified - projects (see option `vhdl-project-alist'). - - The speedbar can be switched between file, directory hierarchy and - project hierarchy browsing mode in the speedbar menu or by typing `f', - `h' or `H' in speedbar. - - In speedbar, open design units with `mouse-2' on the name and browse - their hierarchy with `mouse-2' on the `+'. Ports can directly be copied - from entities and components (in packages). Individual design units and - complete designs can directly be compiled (\"Make\" menu entry). - - The hierarchy is automatically updated upon saving a modified source - file when option `vhdl-speedbar-update-on-saving' is non-nil. The - hierarchy is only updated for projects that have been opened once in the - speedbar. The hierarchy is cached between Emacs sessions in a file (see - options in group `vhdl-speedbar'). - - Simple design consistency checks are done during scanning, such as - multiple declarations of the same unit or missing primary units that are - required by secondary units. - - - STRUCTURAL COMPOSITION: - Enables simple structural composition. `C-c C-m C-n' creates a skeleton - for a new component. Subcomponents (i.e. component declaration and - instantiation) can be automatically placed from a previously read port - (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally, - all subcomponents can be automatically connected using internal signals - and ports (`C-c C-m C-w') following these rules: - - subcomponent actual ports with same name are considered to be - connected by a signal (internal signal or port) - - signals that are only inputs to subcomponents are considered as - inputs to this component -> input port created - - signals that are only outputs from subcomponents are considered as - outputs from this component -> output port created - - signals that are inputs to AND outputs from subcomponents are - considered as internal connections -> internal signal created - - Purpose: With appropriate naming conventions it is possible to - create higher design levels with only a few mouse clicks or key - strokes. A new design level can be created by simply generating a new - component, placing the required subcomponents from the hierarchy - browser, and wiring everything automatically. - - Note: Automatic wiring only works reliably on templates of new - components and component instantiations that were created by VHDL mode. - - Component declarations can be placed in a components package (option - `vhdl-use-components-package') which can be automatically generated for - an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct - component instantiation is also supported (option - `vhdl-use-direct-instantiation'). - - Configuration declarations can automatically be generated either from - the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from - the speedbar menu (for the architecture under the cursor). The - configurations can optionally be hierarchical (i.e. include all - component levels of a hierarchical design, option - `vhdl-compose-configuration-hierarchical') or include subconfigurations - (option `vhdl-compose-configuration-use-subconfiguration'). For - subcomponents in hierarchical configurations, the most-recently-analyzed - (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. - - See the options group `vhdl-compose' for all relevant user options. - - - SOURCE FILE COMPILATION: - The syntax of the current buffer can be analyzed by calling a VHDL - compiler (menu, `C-c C-k'). The compiler to be used is specified by - option `vhdl-compiler'. The available compilers are listed in option - `vhdl-compiler-alist' including all required compilation command, - command options, compilation directory, and error message syntax - information. New compilers can be added. - - All the source files of an entire design can be compiled by the `make' - command (menu, `C-c M-C-k') if an appropriate Makefile exists. - - - MAKEFILE GENERATION: - Makefiles can be generated automatically by an internal generation - routine (`C-c M-k'). The library unit dependency information is - obtained from the hierarchy browser. Makefile generation can be - customized for each compiler in option `vhdl-compiler-alist'. - - Makefile generation can also be run non-interactively using the - command: - - emacs -batch -l ~/.emacs -l vhdl-mode - [-compiler compilername] [-project projectname] - -f vhdl-generate-makefile - - The Makefile's default target \"all\" compiles the entire design, the - target \"clean\" removes it and the target \"library\" creates the - library directory if not existent. These target names can be customized - by option `vhdl-makefile-default-targets'. The Makefile also includes a - target for each primary library unit which allows selective compilation - of this unit, its secondary units and its subhierarchy (example: - compilation of a design specified by a configuration). User specific - parts can be inserted into a Makefile with option - `vhdl-makefile-generation-hook'. - - Limitations: - - Only library units and dependencies within the current library are - considered. Makefiles for designs that span multiple libraries are - not (yet) supported. - - Only one-level configurations are supported (also hierarchical), - but configurations that go down several levels are not. - - The \"others\" keyword in configurations is not supported. - - - PROJECTS: - Projects can be defined in option `vhdl-project-alist' and a current - project be selected using option `vhdl-project' (permanently) or from - the menu or speedbar (temporarily). For each project, title and - description strings (for the file headers), source files/directories - (for the hierarchy browser and Makefile generation), library name, and - compiler-dependent options, exceptions and compilation directory can be - specified. Compilation settings overwrite the settings of option - `vhdl-compiler-alist'. - - Project setups can be exported (i.e. written to a file) and imported. - Imported setups are not automatically saved in `vhdl-project-alist' but - can be saved afterwards in its customization buffer. When starting - Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l - vhdl-mode\") in a directory with an existing project setup file, it is - automatically loaded and its project activated if option - `vhdl-project-autoload' is non-nil. Names/paths of the project setup - files can be specified in option `vhdl-project-file-name'. Multiple - project setups can be automatically loaded from global directories. - This is an alternative to specifying project setups with option - `vhdl-project-alist'. - - - SPECIAL MENUS: - As an alternative to the speedbar, an index menu can be added (set - 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 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. - - - VHDL STANDARDS: - The VHDL standards to be used are specified in option `vhdl-standard'. - Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages. - - - KEYWORD CASE: - Lower and upper case for keywords and standardized types, attributes, - and enumeration values is supported. If the option - `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in - lower case and are converted into upper case automatically (not for - types, attributes, and enumeration values). The case of keywords, - types, attributes,and enumeration values can be fixed for an entire - region (menu) or buffer (`C-c C-x C-c') according to the options - `vhdl-upper-case-{keywords,types,attributes,enum-values}'. - - - HIGHLIGHTING (fontification): - Keywords and standardized types, attributes, enumeration values, and - function names (controlled by option `vhdl-highlight-keywords'), as well - as comments, strings, and template prompts are highlighted using - different colors. Unit, subprogram, signal, variable, constant, - parameter and generic/port names in declarations as well as labels are - highlighted if option `vhdl-highlight-names' is non-nil. - - Additional reserved words or words with a forbidden syntax (e.g. words - that should be avoided) can be specified in option - `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in - a warning color (option `vhdl-highlight-forbidden-words'). Verilog - keywords are highlighted as forbidden words if option - `vhdl-highlight-verilog-keywords' is non-nil. - - Words with special syntax can be highlighted by specifying their - syntax and color in option `vhdl-special-syntax-alist' and by setting - option `vhdl-highlight-special-words' to non-nil. This allows you to - establish some naming conventions (e.g. to distinguish different kinds - of signals or other objects by using name suffices) and to support them - visually. - - Option `vhdl-highlight-case-sensitive' can be set to non-nil in order - to support case-sensitive highlighting. However, keywords are then only - highlighted if written in lower case. - - Code between \"translate_off\" and \"translate_on\" pragmas is - highlighted using a different background color if option - `vhdl-highlight-translate-off' is non-nil. - - For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (\\[customize-group]). For - highlighting of matching parenthesis, see customization group - `paren-showing'. Automatic buffer highlighting is turned on/off by - option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). - - - USER MODELS: - VHDL models (templates) can be specified by the user and made accessible - in the menu, through key bindings (`C-c C-m ...'), or by keyword - electrification. See option `vhdl-model-alist'. - - - HIDE/SHOW: - The code of blocks, processes, subprograms, component declarations and - instantiations, generic/port clauses, and configuration declarations can - be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within - the code (see customization group `vhdl-menu'). XEmacs: limited - functionality due to old `hideshow.el' package. - - - CODE UPDATING: - - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the - current process, `C-c C-u M-s' of all processes in the current buffer. - Limitations: - - Only declared local signals (ports, signals declared in - architecture and blocks) are automatically inserted. - - Global signals declared in packages are not automatically inserted. - Insert them once manually (will be kept afterwards). - - Out parameters of procedures are considered to be read. - Use option `vhdl-entity-file-name' to specify the entity file name - (used to obtain the port names). - Use option `vhdl-array-index-record-field-in-sensitivity-list' to - specify whether to include array indices and record fields in - sensitivity lists. - - - CODE FIXING: - `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause - (e.g., if the closing parenthesis is on the wrong line or is missing). - - - PRINTING: - PostScript printing with different faces (an optimized set of faces is - used if `vhdl-print-customize-faces' is non-nil) or colors (if - `ps-print-color-p' is non-nil) is possible using the standard Emacs - PostScript printing commands. Option `vhdl-print-two-column' defines - appropriate default settings for nice landscape two-column printing. - The paper format can be set by option `ps-paper-type'. Do not forget to - switch `ps-print-color-p' to nil for printing on black-and-white - printers. - - - OPTIONS: - User options allow customization of VHDL Mode. All options are - accessible from the \"Options\" menu entry. Simple options (switches - and choices) can directly be changed, while for complex options a - customization buffer is opened. Changed options can be saved for future - sessions using the \"Save Options\" menu entry. - - Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command \\[customize-option] - (\\[customize-group] for groups). Some customizations only take effect - after some action (read the NOTE in the option documentation). - Customization can also be done globally (i.e. site-wide, read the - INSTALL file). - - Not all options are described in this documentation, so go and see - what other useful user options there are (\\[vhdl-customize] or menu)! - - - FILE EXTENSIONS: - As default, files with extensions \".vhd\" and \".vhdl\" are - automatically recognized as VHDL source files. To add an extension - \".xxx\", add the following line to your Emacs start-up file (`.emacs'): - - (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist) - - - HINTS: - - To start Emacs with open VHDL hierarchy browser without having to load - a VHDL file first, use the command: - - emacs -l vhdl-mode -f speedbar-frame-mode - - - Type `C-g C-g' to interrupt long operations or if Emacs hangs. - - - Some features only work on properly indented code. - - - RELEASE NOTES: - See also the release notes (menu) for added features in new releases. - - -Maintenance: ------------- - -To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. -Add a description of the problem and include a reproducible test case. - -Questions and enhancement requests can be sent to <reto@gnu.org>. - -The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. -The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta -releases. You are kindly invited to participate in beta testing. Subscribe -to above mailing lists by sending an email to <reto@gnu.org>. - -VHDL Mode is officially distributed at -https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html -where the latest version can be found. - - -Known problems: ---------------- - -- XEmacs: Incorrect start-up when automatically opening speedbar. -- XEmacs: Indentation in XEmacs 21.4 (and higher). -- Indentation incorrect for new `postponed' VHDL keyword. -- Indentation incorrect for `protected body' construct. - - - The VHDL Mode Authors - Reto Zimmermann and Rod Whitby - -Key bindings: -------------- - -\\{vhdl-mode-map}" - :abbrev-table vhdl-mode-abbrev-table - - ;; set local variables - (set (make-local-variable 'paragraph-start) - "\\s-*\\(--+\\s-*$\\|$\\)") - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'indent-line-function) #'vhdl-indent-line) - (set (make-local-variable 'comment-start) "--") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-column) vhdl-inline-comment-column) - (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) - (set (make-local-variable 'comment-start-skip) "--+\\s-*") - (set (make-local-variable 'comment-multi-line) nil) - (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) - (set (make-local-variable 'hippie-expand-verbose) nil) - - ;; setup the comment indent variable in an Emacs version portable way - ;; ignore any byte compiler warnings you might get here - (when (boundp 'comment-indent-function) - (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent)) - - ;; initialize font locking - (set (make-local-variable 'font-lock-defaults) - (list - '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line)) - (if (eval-when-compile (fboundp 'syntax-propertize-rules)) - (set (make-local-variable 'syntax-propertize-function) - (syntax-propertize-rules - ;; Mark single quotes as having string quote syntax in - ;; 'c' instances. - ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) - (set (make-local-variable 'font-lock-syntactic-keywords) - vhdl-font-lock-syntactic-keywords)) - (when (featurep 'xemacs) - (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-on-scrolling) t)) - - ;; variables for source file compilation - (when vhdl-compile-use-local-error-regexp - (set (make-local-variable 'compilation-error-regexp-alist) nil) - (set (make-local-variable 'compilation-file-regexp-alist) nil)) - - ;; add index menu - (vhdl-index-menu-init) - ;; add source file menu - (if vhdl-source-file-menu (vhdl-add-source-files-menu)) - ;; add VHDL menu - (when (featurep 'xemacs) - (easy-menu-add vhdl-mode-menu-list)) - (easy-menu-define vhdl-mode-menu vhdl-mode-map - "Menu keymap for VHDL Mode." vhdl-mode-menu-list) - ;; initialize hideshow and add menu - (vhdl-hideshow-init) - (run-hooks 'menu-bar-update-hook) - - ;; miscellaneous - (vhdl-ps-print-init) - (vhdl-write-file-hooks-init) - (message "VHDL Mode %s.%s" vhdl-version - (if noninteractive "" " See menu for documentation and release notes."))) - -(defun vhdl-activate-customizations () - "Activate all customizations on local variables." - (interactive) - (vhdl-mode-map-init) - (use-local-map vhdl-mode-map) - (set-syntax-table vhdl-mode-syntax-table) - (setq comment-column vhdl-inline-comment-column) - (setq end-comment-column vhdl-end-comment-column) - (vhdl-write-file-hooks-init) - (vhdl-update-mode-menu) - (vhdl-hideshow-init) - (run-hooks 'menu-bar-update-hook)) - -(defun vhdl-write-file-hooks-init () - "Add/remove hooks when buffer is saved." - (if vhdl-modify-date-on-saving - (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t) - (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t)) - (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) - (add-hook 'after-save-hook #'vhdl-add-modified-file nil t)) - -(defun vhdl-process-command-line-option (option) - "Process command line options for VHDL Mode." - (cond - ;; set compiler - ((equal option "-compiler") - (vhdl-set-compiler (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))) - ;; set project - ((equal option "-project") - (vhdl-set-project (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))))) - -;; make Emacs process VHDL Mode options -(setq command-switch-alist - (append command-switch-alist - '(("-compiler" . vhdl-process-command-line-option) - ("-project" . vhdl-process-command-line-option)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Keywords and standardized words -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vhdl-02-keywords - '( - "abs" "access" "after" "alias" "all" "and" "architecture" "array" - "assert" "attribute" - "begin" "block" "body" "buffer" "bus" - "case" "component" "configuration" "constant" - "disconnect" "downto" - "else" "elsif" "end" "entity" "exit" - "file" "for" "function" - "generate" "generic" "group" "guarded" - "if" "impure" "in" "inertial" "inout" "is" - "label" "library" "linkage" "literal" "loop" - "map" "mod" - "nand" "new" "next" "nor" "not" "null" - "of" "on" "open" "or" "others" "out" - "package" "port" "postponed" "procedure" "process" "protected" "pure" - "range" "record" "register" "reject" "rem" "report" "return" - "rol" "ror" - "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" - "then" "to" "transport" "type" - "unaffected" "units" "until" "use" - "variable" - "wait" "when" "while" "with" - "xnor" "xor" - ) - "List of VHDL'02 keywords.") - -(defconst vhdl-08-keywords - '( - "context" "force" "property" "release" "sequence" - ) - "List of VHDL'08 keywords.") - -(defconst vhdl-ams-keywords - '( - "across" "break" "limit" "nature" "noise" "procedural" "quantity" - "reference" "spectrum" "subnature" "terminal" "through" - "tolerance" - ) - "List of VHDL-AMS keywords.") - -(defconst vhdl-verilog-keywords - '( - "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" - "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" - "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" - "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" - "endprimitive" "endspecify" "endtable" "endtask" "event" - "for" "force" "forever" "fork" "function" - "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" - "macromodule" "makefile" "medium" "module" - "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" - "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" - "pullup" - "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" - "rtranif0" "rtranif1" - "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" - "strong1" "supply" "supply0" "supply1" - "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" - "triand" "trior" "trireg" - "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" - ) - "List of Verilog keywords as candidate for additional reserved words.") - -(defconst vhdl-02-types - '( - "boolean" "bit" "bit_vector" "character" "severity_level" "integer" - "real" "time" "natural" "positive" "string" "line" "text" "side" - "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" - "std_logic" "std_logic_vector" - "std_ulogic" "std_ulogic_vector" - ) - "List of VHDL'02 standardized types.") - -(defconst vhdl-08-types - '( - "boolean_vector" "integer_vector" "real_vector" "time_vector" - ) - "List of VHDL'08 standardized types.") - -(defconst vhdl-ams-types - ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004 - '( - ;; package `standard' - "domain_type" "real_vector" - ;; package `energy_systems' - "energy" "power" "periodicity" "real_across" "real_through" "unspecified" - "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector" - "real_across_vector" "real_through_vector" - ;; package `electrical_systems' - "voltage" "current" "charge" "resistance" "conductance" "capacitance" - "mmf" "electric_flux" "electric_flux_density" "electric_field_strength" - "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength" - "inductance" "reluctance" "electrical" "electrical_vector" "magnetic" - "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector" - "magnetic_flux_vector" "charge_vector" "resistance_vector" - "conductance_vector" "capacitance_vector" "electric_flux_vector" - "electric_flux_density_vector" "electric_field_strength_vector" - "magnetic_flux_density_vector" "magnetic_field_strength_vector" - "inductance_vector" "reluctance_vector" "ground" - ;; package `mechanical_systems' - "displacement" "force" "velocity" "acceleration" "mass" "stiffness" - "damping" "momentum" "angle" "torque" "angular_velocity" - "angular_acceleration" "moment_inertia" "angular_momentum" - "angular_stiffness" "angular_damping" "translational" - "translational_vector" "translational_velocity" - "translational_velocity_vector" "rotational" "rotational_vector" - "rotational_velocity" "rotational_velocity_vector" "displacement_vector" - "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector" - "torque_vector" "angular_velocity_vector" "torque_velocity_vector" - "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector" - "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector" - "angular_momentum_vector" "angular_stiffness_vector" - "angular_damping_vector" "anchor" "translational_v_ref" - "rotational_v_ref" "translational_v" "rotational_v" - ;; package `radiant_systems' - "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant" - "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector" - "illuminance_vector" "irradiance_vector" - ;; package `thermal_systems' - "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance" - "thermal_conductance" "thermal" "thermal_vector" "temperature_vector" - "heat_flow_vector" "thermal_capacitance_vector" - "thermal_resistance_vector" "thermal_conductance_vector" - ;; package `fluidic_systems' - "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity" - "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance" - "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector" - "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector" - "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector" - "density_vector" "viscosity_vector" "fresistance_vector" - "fconductance_vector" "fcapacitance_vector" "inertance_vector" - "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector" - "cfinertance_vector" - ) - "List of VHDL-AMS standardized types.") - -(defconst vhdl-math-types - '( - "complex" "complex_polar" "positive_real" "principal_value" - ) - "List of Math Packages standardized types.") - -(defconst vhdl-02-attributes - '( - "base" "left" "right" "high" "low" "pos" "val" "succ" - "pred" "leftof" "rightof" "range" "reverse_range" - "length" "delayed" "stable" "quiet" "transaction" - "event" "active" "last_event" "last_active" "last_value" - "driving" "driving_value" "ascending" "value" "image" - "simple_name" "instance_name" "path_name" - "foreign" - ) - "List of VHDL'02 standardized attributes.") - -(defconst vhdl-08-attributes - '( - "instance_name" "path_name" - ) - "List of VHDL'08 standardized attributes.") - -(defconst vhdl-ams-attributes - '( - "across" "through" - "reference" "contribution" "tolerance" - "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" - "ramp" "slew" - ) - "List of VHDL-AMS standardized attributes.") - -(defconst vhdl-02-enum-values - '( - "true" "false" - "note" "warning" "error" "failure" - "read_mode" "write_mode" "append_mode" - "open_ok" "status_error" "name_error" "mode_error" - "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" - "right" "left" - ) - "List of VHDL'02 standardized enumeration values.") - -(defconst vhdl-ams-enum-values - '( - "quiescent_domain" "time_domain" "frequency_domain" - ;; from `nature_pkg' package - "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" - ) - "List of VHDL-AMS standardized enumeration values.") - -(defconst vhdl-ams-constants - ;; standard: IEEE Std 1076.1.1-2004 - '( - ;; package `fundamental_constants' - "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok" - "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto" - "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega" - "giga" "tera" "peta" "exa" "zetta" "yotta" "deca" - ;; package `material_constants' - "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly" - "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2" - "ambient_temperature" "ambient_pressure" "ambient_illuminance" - ) - "List of VHDL-AMS standardized constants.") - -(defconst vhdl-math-constants - ;; standard: IEEE Std 1076.2-1996 - '( - "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi" - "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero" - "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e" - "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2" - "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2" - "math_sqrt_pi" - ) - "List of Math Packages standardized constants.") - -(defconst vhdl-02-functions - '( - "now" "resolved" "rising_edge" "falling_edge" - "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite" - "endfile" - "resize" "is_X" "std_match" - "shift_left" "shift_right" "rotate_left" "rotate_right" - "to_unsigned" "to_signed" "to_integer" - "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" - "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" - "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" - "shl" "shr" "ext" "sxt" - "deallocate" - ) - "List of VHDL'02 standardized functions.") - -(defconst vhdl-08-functions - '( - "finish" "flush" "justify" "maximum" "minimum" - "resolution_limit" "rising_edge" "stop" "swrite" - "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring" - "to_octalstring" "to_ostring" "to_string" - ) - "List of VHDL'08 standardized functions.") - -(defconst vhdl-ams-functions - '( - ;; package `standard' - "frequency" - ) - "List of VHDL-AMS standardized functions.") - -(defconst vhdl-math-functions - ;; standard: IEEE Std 1076.2-1996 - '( - "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg" - "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp" - "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex" - "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt" - "tan" "tanh" "trunc" "uniform" - ) - "List of Math Packages standardized functions.") - -(defconst vhdl-02-packages - '( - "std_logic_1164" "numeric_std" "numeric_bit" - "standard" "textio" - "std_logic_arith" "std_logic_signed" "std_logic_unsigned" - "std_logic_misc" "std_logic_textio" - "ieee" "std" "work" - ) - "List of VHDL'02 standardized packages and libraries.") - -(defconst vhdl-08-packages - '( - "env" "numeric_std_signed" "numeric_std_unsigned" - "ieee_bit_context" "ieee_std_context" ;; contexts - ) - "List of VHDL'08 standardized packages and libraries.") - -(defconst vhdl-ams-packages - '( - "fundamental_constants" "material_constants" "energy_systems" - "electrical_systems" "mechanical_systems" "radiant_systems" - "thermal_systems" "fluidic_systems" - ) - "List of VHDL-AMS standardized packages and libraries.") - -(defconst vhdl-math-packages - '( - "math_real" "math_complex" - ) - "List of Math Packages standardized packages and libraries.") - -(defconst vhdl-08-directives - '( - "author" "author_info" "begin" "begin_protected" "comment" - "data_block" "data_keyname" "data_keyowner" "data_method" - "decrypt_license" "digest_block" "digest_key_method" "digest_keyname" - "digest_keyowner" "digest_method" - "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected" - "key_block" "key_keyname" "key_keyowner" "key_method" - "runtime_license" "viewport" - ) - "List of VHDL'08 standardized tool directives.") - -(defvar vhdl-keywords nil - "List of VHDL keywords.") - -(defvar vhdl-types nil - "List of VHDL standardized types.") - -(defvar vhdl-attributes nil - "List of VHDL standardized attributes.") - -(defvar vhdl-enum-values nil - "List of VHDL standardized enumeration values.") - -(defvar vhdl-constants nil - "List of VHDL standardized constants.") - -(defvar vhdl-functions nil - "List of VHDL standardized functions.") - -(defvar vhdl-packages nil - "List of VHDL standardized packages and libraries.") - -(defvar vhdl-directives nil - "List of VHDL standardized packages and libraries.") - -(defvar vhdl-reserved-words nil - "List of additional reserved words.") - -(defvar vhdl-keywords-regexp nil - "Regexp for VHDL keywords.") - -(defvar vhdl-types-regexp nil - "Regexp for VHDL standardized types.") - -(defvar vhdl-attributes-regexp nil - "Regexp for VHDL standardized attributes.") - -(defvar vhdl-enum-values-regexp nil - "Regexp for VHDL standardized enumeration values.") - -(defvar vhdl-constants-regexp nil - "Regexp for VHDL standardized constants.") - -(defvar vhdl-functions-regexp nil - "Regexp for VHDL standardized functions.") - -(defvar vhdl-packages-regexp nil - "Regexp for VHDL standardized packages and libraries.") - -(defvar vhdl-reserved-words-regexp nil - "Regexp for additional reserved words.") - -(defun vhdl-upcase-list (condition list) - "Upcase all elements in LIST based on CONDITION." - (when condition - (let ((tmp-list list)) - (while tmp-list - (setcar tmp-list (upcase (car tmp-list))) - (setq tmp-list (cdr tmp-list))))) - list) - -(defun vhdl-words-init () - "Initialize reserved words." - (setq vhdl-keywords - (vhdl-upcase-list - (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords) - (append vhdl-02-keywords - (when (vhdl-standard-p '08) vhdl-08-keywords) - (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))) - (setq vhdl-types - (vhdl-upcase-list - (and vhdl-highlight-case-sensitive vhdl-upper-case-types) - (append vhdl-02-types - (when (vhdl-standard-p '08) vhdl-08-types) - (when (vhdl-standard-p 'ams) vhdl-ams-types) - (when (vhdl-standard-p 'math) vhdl-math-types)))) - (setq vhdl-attributes - (vhdl-upcase-list - (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes) - (append vhdl-02-attributes - (when (vhdl-standard-p '08) vhdl-08-attributes) - (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))) - (setq vhdl-enum-values - (vhdl-upcase-list - (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values) - (append vhdl-02-enum-values - (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))) - (setq vhdl-constants - (vhdl-upcase-list - (and vhdl-highlight-case-sensitive vhdl-upper-case-constants) - (append (when (vhdl-standard-p 'ams) vhdl-ams-constants) - (when (vhdl-standard-p 'math) vhdl-math-constants) - '("")))) - (setq vhdl-functions - (append vhdl-02-functions - (when (vhdl-standard-p '08) vhdl-08-functions) - (when (vhdl-standard-p 'ams) vhdl-ams-functions) - (when (vhdl-standard-p 'math) vhdl-math-functions))) - (setq vhdl-packages - (append vhdl-02-packages - (when (vhdl-standard-p '08) vhdl-08-packages) - (when (vhdl-standard-p 'ams) vhdl-ams-packages) - (when (vhdl-standard-p 'math) vhdl-math-packages))) - (setq vhdl-directives - (append (when (vhdl-standard-p '08) vhdl-08-directives))) - (setq vhdl-reserved-words - (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) - (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) - '(""))) - (setq vhdl-keywords-regexp - (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) - (setq vhdl-types-regexp - (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) - (setq vhdl-attributes-regexp - (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) - (setq vhdl-enum-values-regexp - (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) - (setq vhdl-constants-regexp - (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>")) - (setq vhdl-functions-regexp - (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) - (setq vhdl-packages-regexp - (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) - (setq vhdl-reserved-words-regexp - (concat "\\<\\(" - (unless (equal vhdl-forbidden-syntax "") - (concat vhdl-forbidden-syntax "\\|")) - (regexp-opt vhdl-reserved-words) - "\\)\\>")) - (vhdl-abbrev-list-init)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Words to expand - -(defvar vhdl-abbrev-list nil - "Predefined abbreviations for VHDL.") - -(defun vhdl-abbrev-list-init () - (setq vhdl-abbrev-list - (append - (list vhdl-upper-case-keywords) vhdl-keywords - (list vhdl-upper-case-types) vhdl-types - (list vhdl-upper-case-attributes) vhdl-attributes - (list vhdl-upper-case-enum-values) vhdl-enum-values - (list vhdl-upper-case-constants) vhdl-constants - (list nil) vhdl-functions - (list nil) vhdl-packages - (list nil) vhdl-directives))) - -;; initialize reserved words for VHDL Mode -(vhdl-words-init) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Indentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Syntax analysis - -;; constant regular expressions for looking at various constructs - -(defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" - "Regexp describing a VHDL symbol. -We cannot use just `word' syntax class since `_' cannot be in word -class. Putting underscore in word class breaks forward word movement -behavior that users are familiar with.") - -(defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is" - "Regexp describing a case statement header key.") - -(defconst vhdl-label-key - (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") - "Regexp describing a VHDL label.") - -;; Macro definitions: - -(defmacro vhdl-point (position) - "Return the value of point at certain commonly referenced POSITIONs. -POSITION can be one of the following symbols: - -bol -- beginning of line -eol -- end of line -bod -- beginning of defun -boi -- back to indentation -eoi -- last whitespace on line -ionl -- indentation of next line -iopl -- indentation of previous line -bonl -- beginning of next line -bopl -- beginning of previous line - -This function does not modify point or mark." - (or (and (eq 'quote (car-safe position)) - (null (cddr position))) - (error "ERROR: Bad buffer position requested: %s" position)) - (setq position (nth 1 position)) - `(let ((here (point))) - ,@(cond - ((eq position 'bol) '((beginning-of-line))) - ((eq position 'eol) '((end-of-line))) - ((eq position 'bod) '((save-match-data - (vhdl-beginning-of-defun)))) - ((eq position 'boi) '((back-to-indentation))) - ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t"))) - ((eq position 'bonl) '((forward-line 1))) - ((eq position 'bopl) '((forward-line -1))) - ((eq position 'iopl) - '((forward-line -1) - (back-to-indentation))) - ((eq position 'ionl) - '((forward-line 1) - (back-to-indentation))) - (t (error "ERROR: Unknown buffer position requested: %s" position)) - ) - (prog1 - (point) - (goto-char here)) - ;; workaround for an Emacs18 bug -- blech! Well, at least it - ;; doesn't hurt for v19 - ,@nil - )) - -(defmacro vhdl-safe (&rest body) - "Safely execute BODY, return nil if an error occurred." - `(condition-case nil - (progn ,@body) - (error nil))) - -(defmacro vhdl-add-syntax (symbol &optional relpos) - "A simple macro to append the syntax in SYMBOL to the syntax list. -Try to increase performance by using this macro." - `(setq vhdl-syntactic-context - (cons (cons ,symbol ,relpos) vhdl-syntactic-context))) - -(defmacro vhdl-has-syntax (symbol) - "A simple macro to return check the syntax list. -Try to increase performance by using this macro." - `(assoc ,symbol vhdl-syntactic-context)) - -;; Syntactic element offset manipulation: - -(defun vhdl-read-offset (langelem) - "Read new offset value for LANGELEM from minibuffer. -Return a valid value only." - (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) - (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") - (prompt "Offset: ") - offset input interned) - (while (not offset) - (setq input (read-string prompt oldoff) - offset (cond ((string-equal "+" input) '+) - ((string-equal "-" input) '-) - ((string-equal "++" input) '++) - ((string-equal "--" input) '--) - ((string-match "^-?[0-9]+$" input) - (string-to-number input)) - ((fboundp (setq interned (intern input))) - interned) - ((boundp interned) interned) - ;; error, but don't signal one, keep trying - ;; to read an input value - (t (ding) - (setq prompt errmsg) - nil)))) - offset)) - -(defun vhdl-set-offset (symbol offset &optional add-p) - "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. -SYMBOL is the syntactic element symbol to change and OFFSET is the new -offset for that syntactic element. Optional ADD-P says to add SYMBOL to -`vhdl-offsets-alist' if it doesn't already appear there." - (interactive - (let* ((langelem - (intern (completing-read - (concat "Syntactic symbol to change" - (if current-prefix-arg " or add" "") - ": ") - (mapcar - (lambda (langelem) - (cons (format "%s" (car langelem)) nil)) - vhdl-offsets-alist) - nil (not current-prefix-arg) - ;; initial contents tries to be the last element - ;; on the syntactic analysis list for the current - ;; line - (let* ((syntax (vhdl-get-syntactic-context)) - (len (length syntax)) - (ic (format "%s" (car (nth (1- len) syntax))))) - ic) - ))) - (offset (vhdl-read-offset langelem))) - (list langelem offset current-prefix-arg))) - ;; sanity check offset - (or (eq offset '+) - (eq offset '-) - (eq offset '++) - (eq offset '--) - (integerp offset) - (fboundp offset) - (boundp offset) - (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" - offset)) - (let ((entry (assq symbol vhdl-offsets-alist))) - (if entry - (setcdr entry offset) - (if add-p - (setq vhdl-offsets-alist - (cons (cons symbol offset) vhdl-offsets-alist)) - (error "ERROR: %s is not a valid syntactic symbol" symbol)))) - (vhdl-keep-region-active)) - -(defun vhdl-set-style (style &optional local) - "Set `vhdl-mode' variables to use one of several different indentation styles. -STYLE is a string representing the desired style and optional LOCAL is -a flag which, if non-nil, means to make the style variables being -changed buffer local, instead of the default, which is to set the -global variables. Interactively, the flag comes from the prefix -argument. The styles are chosen from the `vhdl-style-alist' variable." - (interactive (list (completing-read "Use which VHDL indentation style? " - vhdl-style-alist nil t) - current-prefix-arg)) - (let ((vars (cdr (assoc style vhdl-style-alist)))) - (or vars - (error "ERROR: Invalid VHDL indentation style `%s'" style)) - ;; set all the variables - (mapc - (lambda (varentry) - (let ((var (car varentry)) - (val (cdr varentry))) - ;; special case for vhdl-offsets-alist - (if (not (eq var 'vhdl-offsets-alist)) - (set (if local (make-local-variable var) var) val) - ;; reset vhdl-offsets-alist to the default value first - (set (if local (make-local-variable var) var) - (copy-alist vhdl-offsets-alist-default)) - ;; now set the langelems that are different - (mapcar - (lambda (langentry) - (let ((langelem (car langentry)) - (offset (cdr langentry))) - (vhdl-set-offset langelem offset) - )) - val)) - )) - vars)) - (vhdl-keep-region-active)) - -(defun vhdl-get-offset (langelem) - "Get offset from LANGELEM which is a cons cell of the form: -\(SYMBOL . RELPOS). The symbol is matched against -vhdl-offsets-alist and the offset found there is either returned, -or added to the indentation at RELPOS. If RELPOS is nil, then -the offset is simply returned." - (let* ((symbol (car langelem)) - (relpos (cdr langelem)) - (match (assq symbol vhdl-offsets-alist)) - (offset (cdr-safe match))) - ;; offset can be a number, a function, a variable, or one of the - ;; symbols + or - - (cond - ((not match) - (if vhdl-strict-syntax-p - (error "ERROR: Don't know how to indent a %s" symbol) - (setq offset 0 - relpos 0))) - ((eq offset '+) (setq offset vhdl-basic-offset)) - ((eq offset '-) (setq offset (- vhdl-basic-offset))) - ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) - ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) - ((and (not (numberp offset)) - (fboundp offset)) - (setq offset (funcall offset langelem))) - ((not (numberp offset)) - (setq offset (eval offset))) - ) - (+ (if (and relpos - (< relpos (vhdl-point 'bol))) - (save-excursion - (goto-char relpos) - (current-column)) - 0) - offset))) - -;; Syntactic support functions: - -(defun vhdl-in-comment-p (&optional pos) - "Check if point is in a comment (include multi-line comments)." - (let ((parse (lambda (p) - (let ((c (char-after p))) - (or (and c (eq (char-syntax c) ?<)) - (nth 4 (parse-partial-sexp - (save-excursion - (beginning-of-defun) - (point)) p))))))) - (save-excursion - (goto-char (or pos (point))) - (or (funcall parse (point)) - ;; `parse-partial-sexp's notion of comments doesn't span lines - (progn - (back-to-indentation) - (unless (eolp) - (forward-char) - (funcall parse (point)))))))) - -(defun vhdl-in-string-p () - "Check if point is in a string." - (eq (vhdl-in-literal) 'string)) - -(defun vhdl-in-quote-p () - "Check if point is in a quote ('x')." - (or (and (> (point) (point-min)) - (< (1+ (point)) (point-max)) - (= (char-before (point)) ?\') - (= (char-after (1+ (point))) ?\')) - (and (> (1- (point)) (point-min)) - (< (point) (point-max)) - (= (char-before (1- (point))) ?\') - (= (char-after (point)) ?\')))) - -(defun vhdl-in-literal () - "Determine if point is in a VHDL literal." - (save-excursion - (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) - (cond - ((nth 3 state) 'string) - ((nth 4 state) 'comment) - ((vhdl-beginning-of-macro) 'pound) - ((vhdl-beginning-of-directive) 'directive) - ;; for multi-line comments - ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment) - (t nil))))) - -(defun vhdl-in-extended-identifier-p () - "Determine if point is inside extended identifier (delimited by `\\')." - (save-match-data - (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t)) - (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t))))) - -(defun vhdl-forward-comment (&optional direction) - "Skip all comments (including whitespace). -Skip backwards if DIRECTION is negative, skip forward otherwise." - (interactive "p") - (if (and direction (< direction 0)) - ;; skip backwards - (progn - (skip-chars-backward " \t\n\r\f") - (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) - (goto-char (match-beginning 3)) - (skip-chars-backward " \t\n\r\f"))) - ;; skip forwards - (skip-chars-forward " \t\n\r\f") - (while (looking-at "--.*") - (goto-char (match-end 0)) - (skip-chars-forward " \t\n\r\f")))) - -;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ -(unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) - (defalias 'vhdl-forward-comment #'forward-comment)) - -(defun vhdl-back-to-indentation () - "Move point to the first non-whitespace character on this line." - (interactive) - (beginning-of-line 1) - (skip-syntax-forward " " (vhdl-point 'eol))) - -;; XEmacs hack: work around old `back-to-indentation' in XEmacs -(when (featurep 'xemacs) - (defalias 'back-to-indentation 'vhdl-back-to-indentation)) - -;; This is the best we can do in Win-Emacs. -(defun vhdl-win-il (&optional lim) - "Determine if point is in a VHDL literal." - (save-excursion - (let* ((here (point)) - (state nil) - (match nil) - (lim (or lim (vhdl-point 'bod)))) - (goto-char lim ) - (while (< (point) here) - (setq match - (and (re-search-forward "--\\|[\"']\\|`" - here 'move) - (buffer-substring (match-beginning 0) (match-end 0)))) - (setq state - (cond - ;; no match - ((null match) nil) - ;; looking at the opening of a VHDL style comment - ((string= "--" match) - (if (<= here (progn (end-of-line) (point))) 'comment)) - ;; looking at a directive - ((string= "`" match) - (if (<= here (progn (end-of-line) (point))) 'directive)) - ;; looking at the opening of a double quote string - ((string= "\"" match) - (if (not (save-restriction - ;; this seems to be necessary since the - ;; re-search-forward will not work without it - (narrow-to-region (point) here) - (re-search-forward - ;; this regexp matches a double quote - ;; which is preceded by an even number - ;; of backslashes, including zero - "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) - 'string)) - ;; looking at the opening of a single quote string - ((string= "'" match) - (if (not (save-restriction - ;; see comments from above - (narrow-to-region (point) here) - (re-search-forward - ;; this matches a single quote which is - ;; preceded by zero or two backslashes. - "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" - here 'move))) - 'string)) - (t nil))) - ) ; end-while - state))) - -(and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-in-literal #'vhdl-win-il)) - -;; Skipping of "syntactic whitespace". Syntactic whitespace is -;; defined as lexical whitespace or comments. Search no farther back -;; or forward than optional LIM. If LIM is omitted, (point-min) is -;; used for backward skipping, (point-max) is used for forward -;; skipping. - -(defun vhdl-forward-syntactic-ws (&optional lim) - "Forward skip of syntactic whitespace." - (let* ((here (point-max)) - (hugenum (point-max))) - (while (/= here (point)) - (setq here (point)) - (vhdl-forward-comment hugenum) - ;; skip preprocessor directives - (when (and (or (eq (char-after) ?#) (eq (char-after) ?`)) - (= (vhdl-point 'boi) (point))) - (while (and (eq (char-before (vhdl-point 'eol)) ?\\) - (= (forward-line 1) 0))) - (end-of-line))) - (if lim (goto-char (min (point) lim))))) - - -;; This is the best we can do in Win-Emacs. -(defun vhdl-win-fsws (&optional lim) - "Forward skip syntactic whitespace for Win-Emacs." - (let ((lim (or lim (point-max))) - stop) - (while (not stop) - (skip-chars-forward " \t\n\r\f" lim) - (cond - ;; vhdl comment - ((looking-at "--") (end-of-line)) - ;; none of the above - (t (setq stop t)))))) - -(and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws)) - -(defun vhdl-beginning-of-macro (&optional _lim) - "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." - (let ((here (point))) - (beginning-of-line) - (while (eq (char-before (1- (point))) ?\\) - (forward-line -1)) - (back-to-indentation) - (if (and (<= (point) here) - (eq (char-after) ?#)) - t - (goto-char here) - nil))) - -(defun vhdl-beginning-of-directive (&optional _lim) - "Go to the beginning of a directive (nicked from `cc-engine')." - (let ((here (point))) - (beginning-of-line) - (while (eq (char-before (1- (point))) ?\\) - (forward-line -1)) - (back-to-indentation) - (if (and (<= (point) here) - (eq (char-after) ?`)) - t - (goto-char here) - nil))) - -(defun vhdl-backward-syntactic-ws (&optional lim) - "Backward skip over syntactic whitespace." - (let* ((here (point-min)) - (hugenum (- (point-max)))) - (while (/= here (point)) - (setq here (point)) - (vhdl-forward-comment hugenum) - (vhdl-beginning-of-macro)) - (if lim (goto-char (max (point) lim))))) - -;; This is the best we can do in Win-Emacs. -(defun vhdl-win-bsws (&optional lim) - "Backward skip syntactic whitespace for Win-Emacs." - (let ((lim (or lim (vhdl-point 'bod))) - stop) - (while (not stop) - (skip-chars-backward " \t\n\r\f" lim) - (cond - ;; vhdl comment - ((eq (vhdl-in-literal) 'comment) - (skip-chars-backward "^-" lim) - (skip-chars-backward "-" lim) - (while (not (or (and (= (following-char) ?-) - (= (char-after (1+ (point))) ?-)) - (<= (point) lim))) - (skip-chars-backward "^-" lim) - (skip-chars-backward "-" lim))) - ;; none of the above - (t (setq stop t)))))) - -(and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws)) - -;; Functions to help finding the correct indentation column: - -(defun vhdl-first-word (point) - "If the keyword at POINT is at boi, return (current-column) at that point. -Otherwise return nil." - (save-excursion - (and (goto-char point) - (eq (point) (vhdl-point 'boi)) - (current-column)))) - -(defun vhdl-last-word (point) - "If keyword at POINT is at eoi, then return (current-column) at that point. -Otherwise, return nil." - (save-excursion - (and (goto-char point) - (save-excursion (or (eq (progn (forward-sexp) (point)) - (vhdl-point 'eoi)) - (looking-at "\\s-*\\(--\\)?"))) - (current-column)))) - -;; Core syntactic evaluation functions: - -(defconst vhdl-libunit-re - "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]") - -(defun vhdl-libunit-p () - (and - (save-excursion - (forward-sexp) - (skip-chars-forward " \t\n\r\f") - (not (looking-at "is\\b[^_]"))) - (save-excursion - (backward-sexp) - (and (not (looking-at "use\\b[^_]")) - (progn - (forward-sexp) - (vhdl-forward-syntactic-ws) - (/= (following-char) ?:)))) - )) - -(defconst vhdl-defun-re - "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") - -(defun vhdl-defun-p () - (save-excursion - (if (looking-at "block\\|process\\|procedural") - ;; "block", "process", "procedural": - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w"))) - ;; "architecture", "configuration", "context", "entity", - ;; "package", "procedure", "function": - t))) - -(defun vhdl-corresponding-defun () - "If the word at the current position corresponds to a \"defun\" -keyword, then return a string that can be used to find the -corresponding \"begin\" keyword, else return nil." - (save-excursion - (and (looking-at vhdl-defun-re) - (vhdl-defun-p) - (if (looking-at "block\\|process\\|procedural") - ;; "block", "process". "procedural: - (buffer-substring (match-beginning 0) (match-end 0)) - ;; "architecture", "configuration", "context", "entity", "package", - ;; "procedure", "function": - "is")))) - -(defconst vhdl-begin-fwd-re - "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)" - "Regexp for searching forward that matches all known \"begin\" keywords.") - -(defconst vhdl-begin-bwd-re - "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]" - "Regexp for searching backward that matches all known \"begin\" keywords.") - -(defun vhdl-begin-p (&optional lim) - "Return t if we are looking at a real \"begin\" keyword. -Assumes that the caller will make sure that we are looking at -vhdl-begin-fwd-re, and are not inside a literal, and that we are not in -the middle of an identifier that just happens to contain a \"begin\" -keyword." - (cond - ;; "[architecture|case|configuration|context|entity|package| - ;; procedure|function] ... is": - ((and (looking-at "i") - (save-excursion - ;; Skip backward over first sexp (needed to skip over a - ;; procedure interface list, and is harmless in other - ;; situations). Note that we need "return" in the - ;; following search list so that we don't run into - ;; semicolons in the function interface list. - (backward-sexp) - (skip-chars-forward "(") - (let (foundp) - (while (and (not foundp) - (re-search-backward - ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" - lim 'move)) - (if (or (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - (setq foundp t)))) - (and (/= (following-char) ?\;) - (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) - t) - ;; "begin", "then", "use": - ((looking-at "be\\|t\\|use") - t) - ;; "else": - ((and (looking-at "e") - ;; make sure that the "else" isn't inside a - ;; conditional signal assignment. - (save-excursion - (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) - (or (eq (following-char) ?\;) - (eq (point) lim)))) - t) - ;; "block", "generate", "loop", "process", "procedural", - ;; "units", "record", "protected body": - ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record") - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w")))) - t) - ;; "component": - ((and (looking-at "c") - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w"))) - ;; look out for the dreaded entity class in an attribute - (save-excursion - (vhdl-backward-syntactic-ws lim) - (/= (preceding-char) ?:))) - t) - ;; "for" (inside configuration declaration): - ((and (looking-at "f") - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w"))) - (vhdl-has-syntax 'configuration)) - t) - )) - -(defun vhdl-corresponding-mid (&optional _lim) - (cond - ((looking-at "is\\|block\\|generate\\|process\\|procedural") - "begin") - ((looking-at "then\\|use") - "<else>") - (t - "end"))) - -(defun vhdl-corresponding-end (&optional lim) - "If the word at the current position corresponds to a \"begin\" -keyword, then return a vector containing enough information to find -the corresponding \"end\" keyword, else return nil. The keyword to -search forward for is aref 0. The column in which the keyword must -appear is aref 1 or nil if any column is suitable. -Assumes that the caller will make sure that we are not in the middle -of an identifier that just happens to contain a \"begin\" keyword." - (save-excursion - (and (looking-at vhdl-begin-fwd-re) - (or (not (looking-at "\\<use\\>")) - (save-excursion (back-to-indentation) - (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) - (/= (preceding-char) ?_) - (not (vhdl-in-literal)) - (vhdl-begin-p lim) - (cond - ;; "is", "generate", "loop": - ((looking-at "[igl]") - (vector "end" - (and (vhdl-last-word (point)) - (or (vhdl-first-word (point)) - (save-excursion - (vhdl-beginning-of-statement-1 lim) - (vhdl-backward-skip-label lim) - (vhdl-first-word (point))))))) - ;; "begin", "else", "for": - ((looking-at "be\\|[ef]") - (vector "end" - (and (vhdl-last-word (point)) - (or (vhdl-first-word (point)) - (save-excursion - (vhdl-beginning-of-statement-1 lim) - (vhdl-backward-skip-label lim) - (vhdl-first-word (point))))))) - ;; "component", "units", "record", "protected body": - ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record") - ;; The first end found will close the block - (vector "end" nil)) - ;; "block", "process", "procedural": - ((looking-at "bl\\|p") - (vector "end" - (or (vhdl-first-word (point)) - (save-excursion - (vhdl-beginning-of-statement-1 lim) - (vhdl-backward-skip-label lim) - (vhdl-first-word (point)))))) - ;; "then": - ((looking-at "t\\|use") - (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)" - (and (vhdl-last-word (point)) - (or (vhdl-first-word (point)) - (save-excursion - (vhdl-beginning-of-statement-1 lim) - (vhdl-backward-skip-label lim) - (vhdl-first-word (point))))))) - )))) - -(defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") - -(defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") - -(defun vhdl-end-p (&optional lim) - "Return t if we are looking at a real \"end\" keyword. -Assumes that the caller will make sure that we are looking at -vhdl-end-fwd-re, and are not inside a literal, and that we are not in -the middle of an identifier that just happens to contain an \"end\" -keyword." - (or (not (looking-at "else")) - ;; make sure that the "else" isn't inside a conditional signal - ;; assignment. - (save-excursion - (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) - (or (eq (following-char) ?\;) - (eq (point) lim) - (vhdl-in-literal))))) - -(defun vhdl-corresponding-begin (&optional lim) - "If the word at the current position corresponds to an \"end\" -keyword, then return a vector containing enough information to find -the corresponding \"begin\" keyword, else return nil. The keyword to -search backward for is aref 0. The column in which the keyword must -appear is aref 1 or nil if any column is suitable. The supplementary -keyword to search forward for is aref 2 or nil if this is not -required. If aref 3 is t, then the \"begin\" keyword may be found in -the middle of a statement. -Assumes that the caller will make sure that we are not in the middle -of an identifier that just happens to contain an \"end\" keyword." - (save-excursion - (let (pos) - (if (and (looking-at vhdl-end-fwd-re) - (not (vhdl-in-literal)) - (vhdl-end-p lim)) - (if (looking-at "el") - ;; "else", "elsif": - (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil) - ;; "end ...": - (setq pos (point)) - (forward-sexp) - (skip-chars-forward " \t\n\r\f") - (cond - ;; "end if": - ((looking-at "if\\b[^_]") - (vector "else\\|elsif\\|if" - (vhdl-first-word pos) - "else\\|then\\|use" nil)) - ;; "end component": - ((looking-at "component\\b[^_]") - (vector (buffer-substring (match-beginning 1) - (match-end 1)) - (vhdl-first-word pos) - nil nil)) - ;; "end units", "end record", "end protected": - ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]") - (vector (buffer-substring (match-beginning 1) - (match-end 1)) - (vhdl-first-word pos) - nil t)) - ;; "end block", "end process", "end procedural": - ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") - (vector "begin" (vhdl-first-word pos) nil nil)) - ;; "end case": - ((looking-at "case\\b[^_]") - (vector "case" (vhdl-first-word pos) "is" nil)) - ;; "end generate": - ((looking-at "generate\\b[^_]") - (vector "generate\\|for\\|if" - (vhdl-first-word pos) - "generate" nil)) - ;; "end loop": - ((looking-at "loop\\b[^_]") - (vector "loop\\|while\\|for" - (vhdl-first-word pos) - "loop" nil)) - ;; "end for" (inside configuration declaration): - ((looking-at "for\\b[^_]") - (vector "for" (vhdl-first-word pos) nil nil)) - ;; "end [id]": - (t - (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function" - (vhdl-first-word pos) - ;; return an alist of (statement . keyword) mappings - '( - ;; "begin ... end [id]": - ("begin" . nil) - ;; "architecture ... is ... begin ... end [id]": - ("architecture" . "is") - ;; "configuration ... is ... end [id]": - ("configuration" . "is") - ;; "context ... is ... end [id]": - ("context" . "is") - ;; "entity ... is ... end [id]": - ("entity" . "is") - ;; "package ... is ... end [id]": - ("package" . "is") - ;; "procedure ... is ... begin ... end [id]": - ("procedure" . "is") - ;; "function ... is ... begin ... end [id]": - ("function" . "is") - ) - nil)) - ))) ; "end ..." - ))) - -(defconst vhdl-leader-re - "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") - -(defun vhdl-end-of-leader () - (save-excursion - (cond ((looking-at "block\\|process\\|procedural") - (if (save-excursion - (forward-sexp) - (skip-chars-forward " \t\n\r\f") - (= (following-char) ?\()) - (forward-sexp 2) - (forward-sexp)) - (when (looking-at "[ \t\n\r\f]*is") - (goto-char (match-end 0))) - (point)) - ((looking-at "component") - (forward-sexp 2) - (when (looking-at "[ \t\n\r\f]*is") - (goto-char (match-end 0))) - (point)) - ((looking-at "for") - (forward-sexp 2) - (skip-chars-forward " \t\n\r\f") - (while (looking-at "[,:(]") - (forward-sexp) - (skip-chars-forward " \t\n\r\f")) - (point)) - (t nil) - ))) - -(defconst vhdl-trailer-re - "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]") - -(defconst vhdl-statement-fwd-re - "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)" - "Regexp for searching forward that matches all known \"statement\" keywords.") - -(defconst vhdl-statement-bwd-re - "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]" - "Regexp for searching backward that matches all known \"statement\" keywords.") - -(defun vhdl-statement-p (&optional _lim) - "Return t if we are looking at a real \"statement\" keyword. -Assumes that the caller will make sure that we are looking at -vhdl-statement-fwd-re, and are not inside a literal, and that we are not -in the middle of an identifier that just happens to contain a -\"statement\" keyword." - (cond - ;; "for" ... "generate": - ((and (looking-at "f") - ;; Make sure it's the start of a parameter specification. - (save-excursion - (forward-sexp 2) - (skip-chars-forward " \t\n\r\f") - (looking-at "in\\b[^_]")) - ;; Make sure it's not an "end for". - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w")))) - t) - ;; "if" ... "then", "if" ... "generate", "if" ... "loop": - ((and (looking-at "i") - ;; Make sure it's not an "end if". - (save-excursion - (backward-sexp) - (not (looking-at "end\\s-+\\w")))) - t) - ;; "while" ... "loop": - ((looking-at "w") - t) - )) - -(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>" - "Regexp describing a case statement alternative key.") - -(defun vhdl-case-alternative-p (&optional lim) - "Return t if we are looking at a real case alternative. -Assumes that the caller will make sure that we are looking at -vhdl-case-alternative-re, and are not inside a literal, and that -we are not in the middle of an identifier that just happens to -contain a \"when\" keyword." - (save-excursion - (let (foundp) - (while (and (not foundp) - (re-search-backward ";\\|<=" lim 'move)) - (if (or (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - (setq foundp t))) - (or (eq (following-char) ?\;) - (eq (point) lim))) - )) - -;; Core syntactic movement functions: - -(defconst vhdl-b-t-b-re - (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) - -(defun vhdl-backward-to-block (&optional lim) - "Move backward to the previous \"begin\" or \"end\" keyword." - (let (foundp) - (while (and (not foundp) - (re-search-backward vhdl-b-t-b-re lim 'move)) - (if (or (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - (cond - ;; "begin" keyword: - ((and (looking-at vhdl-begin-fwd-re) - (or (not (looking-at "\\<use\\>")) - (save-excursion (back-to-indentation) - (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) - (/= (preceding-char) ?_) - (vhdl-begin-p lim)) - (setq foundp 'begin)) - ;; "end" keyword: - ((and (looking-at vhdl-end-fwd-re) - (/= (preceding-char) ?_) - (vhdl-end-p lim)) - (setq foundp 'end)) - )) - ) - foundp - )) - -(defun vhdl-forward-sexp (&optional count lim) - "Move forward across one balanced expression (sexp). -With COUNT, do it that many times." - (interactive "p") - (let ((count (or count 1)) - (case-fold-search t) - end-vec target) - (save-excursion - (while (> count 0) - ;; skip whitespace - (skip-chars-forward " \t\n\r\f") - ;; Check for an unbalanced "end" keyword - (if (and (looking-at vhdl-end-fwd-re) - (/= (preceding-char) ?_) - (not (vhdl-in-literal)) - (vhdl-end-p lim) - (not (looking-at "else"))) - (error - "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) - ;; If the current keyword is a "begin" keyword, then find the - ;; corresponding "end" keyword. - (if (setq end-vec (vhdl-corresponding-end lim)) - (let ( - ;; end-re is the statement keyword to search for - (end-re - (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) - ;; column is either the statement keyword target column - ;; or nil - (column (aref end-vec 1)) - (eol (vhdl-point 'eol)) - foundp literal placeholder) - ;; Look for the statement keyword. - (while (and (not foundp) - (re-search-forward end-re nil t) - (setq placeholder (match-end 1)) - (goto-char (match-beginning 0))) - ;; If we are in a literal, or not in the right target - ;; column and not on the same line as the begin, then - ;; try again. - (if (or (and column - (/= (current-indentation) column) - (> (point) eol)) - (= (preceding-char) ?_) - (setq literal (vhdl-in-literal))) - (if (eq literal 'comment) - (end-of-line) - (forward-char)) - ;; An "else" keyword corresponds to both the opening brace - ;; of the following sexp and the closing brace of the - ;; previous sexp. - (if (not (looking-at "else")) - (goto-char placeholder)) - (setq foundp t)) - ) - (if (not foundp) - (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) - ) - ;; If the current keyword is not a "begin" keyword, then just - ;; perform the normal forward-sexp. - (forward-sexp) - ) - (setq count (1- count)) - ) - (setq target (point))) - (goto-char target) - nil)) - -(defun vhdl-backward-sexp (&optional count lim) - "Move backward across one balanced expression (sexp). -With COUNT, do it that many times. LIM bounds any required backward -searches." - (interactive "p") - (let ((count (or count 1)) - (case-fold-search t) - begin-vec target) - (save-excursion - (while (> count 0) - ;; Perform the normal backward-sexp, unless we are looking at - ;; "else" - an "else" keyword corresponds to both the opening brace - ;; of the following sexp and the closing brace of the previous sexp. - (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") - (/= (preceding-char) ?_) - (not (vhdl-in-literal))) - nil - (backward-sexp) - (if (and (looking-at vhdl-begin-fwd-re) - (or (not (looking-at "\\<use\\>")) - (save-excursion - (back-to-indentation) - (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) - (/= (preceding-char) ?_) - (not (vhdl-in-literal)) - (vhdl-begin-p lim)) - (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) - ;; If the current keyword is an "end" keyword, then find the - ;; corresponding "begin" keyword. - (if (and (setq begin-vec (vhdl-corresponding-begin lim)) - (/= (preceding-char) ?_)) - (let ( - ;; begin-re is the statement keyword to search for - (begin-re - (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) - ;; column is either the statement keyword target column - ;; or nil - (column (aref begin-vec 1)) - ;; internal-p controls where the statement keyword can - ;; be found. - (internal-p (aref begin-vec 3)) - (last-backward (point)) ;; last-forward - foundp literal keyword) - ;; Look for the statement keyword. - (while (and (not foundp) - (re-search-backward begin-re lim t) - (setq keyword - (buffer-substring (match-beginning 1) - (match-end 1)))) - ;; If we are in a literal or in the wrong column, - ;; then try again. - (if (or (and column - (and (/= (current-indentation) column) - ;; possibly accept current-column as - ;; well as current-indentation. - (or (not internal-p) - (/= (current-column) column)))) - (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - ;; If there is a supplementary keyword, then - ;; search forward for it. - (if (and (setq begin-re (aref begin-vec 2)) - (or (not (listp begin-re)) - ;; If begin-re is an alist, then find the - ;; element corresponding to the actual - ;; keyword that we found. - (progn - (setq begin-re - (assoc keyword begin-re)) - (and begin-re - (setq begin-re (cdr begin-re)))))) - (and - (setq begin-re - (concat "\\b\\(" begin-re "\\)\\b[^_]")) - (save-excursion - ;; (setq last-forward (point)) - ;; Look for the supplementary keyword - ;; (bounded by the backward search start - ;; point). - (while (and (not foundp) - (re-search-forward begin-re - last-backward t) - (goto-char (match-beginning 1))) - ;; If we are in a literal, then try again. - (if (or (= (preceding-char) ?_) - (setq literal - (vhdl-in-literal))) - (if (eq literal 'comment) - (goto-char - (min (vhdl-point 'eol) last-backward)) - (forward-char)) - ;; We have found the supplementary keyword. - ;; Save the position of the keyword in foundp. - (setq foundp (point))) - ) - foundp) - ;; If the supplementary keyword was found, then - ;; move point to the supplementary keyword. - (goto-char foundp)) - ;; If there was no supplementary keyword, then - ;; point is already at the statement keyword. - (setq foundp t))) - ) ; end of the search for the statement keyword - (if (not foundp) - (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) - )) - (setq count (1- count)) - ) - (setq target (point))) - (goto-char target) - nil)) - -(defun vhdl-backward-up-list (&optional count limit) - "Move backward out of one level of blocks. -With argument, do this that many times." - (interactive "p") - (let ((count (or count 1)) - target) - (save-excursion - (while (> count 0) - (if (looking-at vhdl-defun-re) - (error "ERROR: Unbalanced blocks")) - (vhdl-backward-to-block limit) - (setq count (1- count))) - (setq target (point))) - (goto-char target))) - -(defun vhdl-end-of-defun (&optional _count) - "Move forward to the end of a VHDL defun." - (interactive) - (let ((case-fold-search t)) - (vhdl-beginning-of-defun) - (if (not (looking-at "block\\|process\\|procedural")) - (re-search-forward "\\bis\\b")) - (vhdl-forward-sexp))) - -(defun vhdl-mark-defun () - "Put mark at end of this \"defun\", point at beginning." - (interactive) - (let ((case-fold-search t)) - (push-mark) - (vhdl-beginning-of-defun) - (push-mark) - (if (not (looking-at "block\\|process\\|procedural")) - (re-search-forward "\\bis\\b")) - (vhdl-forward-sexp) - (exchange-point-and-mark))) - -(defun vhdl-beginning-of-libunit () - "Move backward to the beginning of a VHDL library unit. -Returns the location of the corresponding begin keyword, unless search -stops due to beginning or end of buffer. -Note that if point is between the \"libunit\" keyword and the -corresponding \"begin\" keyword, then that libunit will not be -recognized, and the search will continue backwards. If point is -at the \"begin\" keyword, then the defun will be recognized. The -returned point is at the first character of the \"libunit\" keyword." - (let ((last-forward (point)) - (last-backward - ;; Just in case we are actually sitting on the "begin" - ;; keyword, allow for the keyword and an extra character, - ;; as this will be used when looking forward for the - ;; "begin" keyword. - (save-excursion (forward-word-strictly 1) (1+ (point)))) - foundp literal placeholder) - ;; Find the "libunit" keyword. - (while (and (not foundp) - (re-search-backward vhdl-libunit-re nil 'move)) - ;; If we are in a literal, or not at a real libunit, then try again. - (if (or (= (preceding-char) ?_) - (vhdl-in-literal) - (not (vhdl-libunit-p))) - (backward-char) - ;; Find the corresponding "begin" keyword. - (setq last-forward (point)) - (while (and (not foundp) - (re-search-forward "\\bis\\b[^_]" last-backward t) - (setq placeholder (match-beginning 0))) - (if (or (= (preceding-char) ?_) - (setq literal (vhdl-in-literal))) - ;; It wasn't a real keyword, so keep searching. - (if (eq literal 'comment) - (goto-char - (min (vhdl-point 'eol) last-backward)) - (forward-char)) - ;; We have found the begin keyword, loop will exit. - (setq foundp placeholder))) - ;; Go back to the libunit keyword - (goto-char last-forward))) - foundp)) - -(defun vhdl-beginning-of-defun (&optional count) - "Move backward to the beginning of a VHDL defun. -With argument, do it that many times. -Returns the location of the corresponding begin keyword, unless search -stops due to beginning or end of buffer." - ;; Note that if point is between the "defun" keyword and the - ;; corresponding "begin" keyword, then that defun will not be - ;; recognized, and the search will continue backwards. If point is - ;; at the "begin" keyword, then the defun will be recognized. The - ;; returned point is at the first character of the "defun" keyword. - (interactive "p") - (let ((count (or count 1)) - (case-fold-search t) - (last-forward (point)) - foundp) - (while (> count 0) - (setq foundp nil) - (goto-char last-forward) - (let ((last-backward - ;; Just in case we are actually sitting on the "begin" - ;; keyword, allow for the keyword and an extra character, - ;; as this will be used when looking forward for the - ;; "begin" keyword. - (save-excursion (forward-word-strictly 1) (1+ (point)))) - begin-string literal) - (while (and (not foundp) - (re-search-backward vhdl-defun-re nil 'move)) - ;; If we are in a literal, then try again. - (if (or (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - (if (setq begin-string (vhdl-corresponding-defun)) - ;; This is a real defun keyword. - ;; Find the corresponding "begin" keyword. - ;; Look for the begin keyword. - (progn - ;; Save the search start point. - (setq last-forward (point)) - (while (and (not foundp) - (search-forward begin-string last-backward t)) - (if (or (= (preceding-char) ?_) - (save-match-data - (setq literal (vhdl-in-literal)))) - ;; It wasn't a real keyword, so keep searching. - (if (eq literal 'comment) - (goto-char - (min (vhdl-point 'eol) last-backward)) - (forward-char)) - ;; We have found the begin keyword, loop will exit. - (setq foundp (match-beginning 0))) - ) - ;; Go back to the defun keyword - (goto-char last-forward)) ; end search for begin keyword - )) - ) ; end of the search for the defun keyword - ) - (setq count (1- count)) - ) - (vhdl-keep-region-active) - foundp)) - -(defun vhdl-beginning-of-statement (&optional count lim interactive) - "Go to the beginning of the innermost VHDL statement. -With prefix arg, go back N - 1 statements. If already at the -beginning of a statement then go to the beginning of the preceding -one. If within a string or comment, or next to a comment (only -whitespace between), move by sentences instead of statements. - -When called from a program, this function takes 3 optional args: the -prefix arg, a buffer position limit which is the farthest back to -search, and an argument indicating an interactive call." - (interactive "p\np") - (let ((count (or count 1)) - (case-fold-search t) - (lim (or lim (point-min))) - (here (point)) - state) - (save-excursion - (goto-char lim) - (setq state (parse-partial-sexp (point) here nil nil))) - (if (and interactive - (or (nth 3 state) - (nth 4 state) - (looking-at (concat "[ \t]*\\(?:" comment-start-skip "\\)")))) - (forward-sentence (- count)) - (while (> count 0) - (vhdl-beginning-of-statement-1 lim) - (setq count (1- count)))) - ;; its possible we've been left up-buf of lim - (goto-char (max (point) lim)) - ) - (vhdl-keep-region-active)) - -(defconst vhdl-e-o-s-re - (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) - -(defun vhdl-end-of-statement () - "Very simple implementation." - (interactive) - (re-search-forward vhdl-e-o-s-re)) - -(defconst vhdl-b-o-s-re - (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|" - vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) - -(defun vhdl-beginning-of-statement-1 (&optional lim) - "Move to the start of the current statement. -If already at the beginning of a statement, move to the start of -the previous statement instead." - (let ((lim (or lim (point-min))) - (here (point)) - (pos (point)) - donep) - ;; go backwards one balanced expression, but be careful of - ;; unbalanced paren being reached - (if (not (vhdl-safe (progn (backward-sexp) t))) - (progn - (backward-up-list 1) - (forward-char) - (vhdl-forward-syntactic-ws here) - (setq donep t))) - (while (and (not donep) - (not (bobp)) - ;; look backwards for a statement boundary - (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move))) - (if (or (= (preceding-char) ?_) - (vhdl-in-literal)) - (backward-char) - (cond - ;; If we are looking at an open paren, then stop after it - ((eq (following-char) ?\() - (forward-char) - (vhdl-forward-syntactic-ws here) - (setq donep t)) - ;; If we are looking at a close paren, then skip it - ((eq (following-char) ?\)) - (forward-char) - (setq pos (point)) - (backward-sexp) - (if (< (point) lim) - (progn (goto-char pos) - (vhdl-forward-syntactic-ws here) - (setq donep t)))) - ;; If we are looking at a semicolon, then stop - ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p))) - (progn - (forward-char) - (vhdl-forward-syntactic-ws here) - (setq donep t))) - ;; If we are looking at a "begin", then stop - ((and (looking-at vhdl-begin-fwd-re) - (or (not (looking-at "\\<use\\>")) - (save-excursion - (back-to-indentation) - (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) - (/= (preceding-char) ?_) - (vhdl-begin-p nil)) - ;; If it's a leader "begin", then find the - ;; right place - (if (looking-at vhdl-leader-re) - (save-excursion - ;; set a default stop point at the begin - (setq pos (point)) - ;; is the start point inside the leader area ? - (goto-char (vhdl-end-of-leader)) - (vhdl-forward-syntactic-ws here) - (if (< (point) here) - ;; start point was not inside leader area - ;; set stop point at word after leader - (setq pos (point)))) - (unless (looking-at "\\<else\\s-+generate\\>") - (forward-word-strictly 1)) - (vhdl-forward-syntactic-ws here) - (setq pos (point))) - (goto-char pos) - (setq donep t)) - ;; If we are looking at a "statement", then stop - ((and (looking-at vhdl-statement-fwd-re) - (/= (preceding-char) ?_) - (vhdl-statement-p nil)) - (setq donep t)) - ;; If we are looking at a case alternative key, then stop - ((and (looking-at vhdl-case-alternative-re) - (vhdl-case-alternative-p lim)) - (save-excursion - ;; set a default stop point at the when - (setq pos (point)) - ;; is the start point inside the case alternative key ? - (looking-at vhdl-case-alternative-re) - (goto-char (match-end 0)) - (vhdl-forward-syntactic-ws here) - (if (< (point) here) - ;; start point was not inside the case alternative key - ;; set stop point at word after case alternative keyleader - (setq pos (point)))) - (goto-char pos) - (setq donep t)) - ;; Bogus find, continue - (t - (backward-char))))) - )) - -;; Defuns for calculating the current syntactic state: - -(defun vhdl-get-library-unit (bod placeholder) - "If there is an enclosing library unit at BOD, with its \"begin\" -keyword at PLACEHOLDER, then return the library unit type." - (let ((here (vhdl-point 'bol))) - (if (save-excursion - (goto-char placeholder) - (vhdl-safe (vhdl-forward-sexp 1 bod)) - (<= here (point))) - (save-excursion - (goto-char bod) - (cond - ((looking-at "e") 'entity) - ((looking-at "a") 'architecture) - ((looking-at "conf") 'configuration) - ((looking-at "cont") 'context) - ((looking-at "p") - (save-excursion - (goto-char bod) - (forward-sexp) - (vhdl-forward-syntactic-ws here) - (if (looking-at "body\\b[^_]") - 'package-body 'package)))))) - )) - -(defun vhdl-get-block-state (&optional lim) - "Find and records all the closest opens. -LIM is the furthest back we need to search (it should be the -previous libunit keyword)." - (let ((here (point)) - (lim (or lim (point-min))) - keyword sexp-start sexp-mid sexp-end - preceding-sexp containing-sexp - containing-begin containing-mid containing-paren) - (save-excursion - ;; Find the containing-paren, and use that as the limit - (if (setq containing-paren - (save-restriction - (narrow-to-region lim (point)) - (vhdl-safe (scan-lists (point) -1 1)))) - (setq lim containing-paren)) - ;; Look backwards for "begin" and "end" keywords. - (while (and (> (point) lim) - (not containing-sexp)) - (setq keyword (vhdl-backward-to-block lim)) - (cond - ((eq keyword 'begin) - ;; Found a "begin" keyword - (setq sexp-start (point)) - (setq sexp-mid (vhdl-corresponding-mid lim)) - (setq sexp-end (vhdl-safe - (save-excursion - (vhdl-forward-sexp 1 lim) (point)))) - (if (and sexp-end (<= sexp-end here)) - ;; we want to record this sexp, but we only want to - ;; record the last-most of any of them before here - (or preceding-sexp - (setq preceding-sexp sexp-start)) - ;; we're contained in this sexp so put sexp-start on - ;; front of list - (setq containing-sexp sexp-start) - (setq containing-mid sexp-mid) - (setq containing-begin t))) - ((eq keyword 'end) - ;; Found an "end" keyword - (forward-sexp) - (setq sexp-end (point)) - (setq sexp-mid nil) - (setq sexp-start - (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) - (progn (backward-sexp) (point)))) - ;; we want to record this sexp, but we only want to - ;; record the last-most of any of them before here - (or preceding-sexp - (setq preceding-sexp sexp-start))) - ))) - ;; Check if the containing-paren should be the containing-sexp - (if (and containing-paren - (or (null containing-sexp) - (< containing-sexp containing-paren))) - (setq containing-sexp containing-paren - preceding-sexp nil - containing-begin nil - containing-mid nil)) - (vector containing-sexp preceding-sexp containing-begin containing-mid) - )) - - -(defconst vhdl-s-c-a-re - (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) - -(defun vhdl-skip-case-alternative (&optional lim) - "Skip forward over case/when bodies, with optional maximal limit. -If no next case alternative is found, nil is returned and point -is not moved." - (let ((lim (or lim (point-max))) - (here (point)) - donep foundp) - (while (and (< (point) lim) - (not donep)) - (if (and (re-search-forward vhdl-s-c-a-re lim 'move) - (save-match-data - (not (vhdl-in-literal))) - (/= (match-beginning 0) here)) - (progn - (goto-char (match-beginning 0)) - (cond - ((and (looking-at "case") - (re-search-forward "\\bis[^_]" lim t)) - (backward-sexp) - (vhdl-forward-sexp)) - (t - (setq donep t - foundp t)))))) - (if (not foundp) - (goto-char here)) - foundp)) - -(defun vhdl-backward-skip-label (&optional lim) - "Skip backward over a label, with optional maximal limit. -If label is not found, nil is returned and point is not moved." - (let ((lim (or lim (point-min))) - placeholder) - (if (save-excursion - (vhdl-backward-syntactic-ws lim) - (and (eq (preceding-char) ?:) - (progn - (backward-sexp) - (setq placeholder (point)) - (looking-at vhdl-label-key)))) - (goto-char placeholder)) - )) - -(defun vhdl-forward-skip-label (&optional lim) - "Skip forward over a label, with optional maximal limit. -If label is not found, nil is returned and point is not moved." - (let ((lim (or lim (point-max)))) - (if (looking-at vhdl-label-key) - (progn - (goto-char (match-end 0)) - (vhdl-forward-syntactic-ws lim))) - )) - -(defun vhdl-get-syntactic-context () - "Guess the syntactic description of the current line of VHDL code." - (save-excursion - (save-restriction - (beginning-of-line) - (let* ((indent-point (point)) - (case-fold-search t) - vec literal containing-sexp preceding-sexp - containing-begin containing-mid containing-leader - char-before-ip char-after-ip begin-after-ip end-after-ip - placeholder lim library-unit - ) - - ;; Reset the syntactic context - (setq vhdl-syntactic-context nil) - - (save-excursion - ;; Move to the start of the previous library unit, and - ;; record the position of the "begin" keyword. - (setq placeholder (vhdl-beginning-of-libunit)) - ;; The position of the "libunit" keyword gives us a gross - ;; limit point. - (setq lim (point)) - ) - - ;; If there is a previous library unit, and we are enclosed by - ;; it, then set the syntax accordingly. - (and placeholder - (setq library-unit (vhdl-get-library-unit lim placeholder)) - (vhdl-add-syntax library-unit lim)) - - ;; Find the surrounding state. - (if (setq vec (vhdl-get-block-state lim)) - (progn - (setq containing-sexp (aref vec 0)) - (setq preceding-sexp (aref vec 1)) - (setq containing-begin (aref vec 2)) - (setq containing-mid (aref vec 3)) - )) - - ;; set the limit on the farthest back we need to search - (setq lim (if containing-sexp - (save-excursion - (goto-char containing-sexp) - ;; set containing-leader if required - (if (looking-at vhdl-leader-re) - (setq containing-leader (vhdl-end-of-leader))) - (vhdl-point 'bol)) - (point-min))) - - ;; cache char before and after indent point, and move point to - ;; the most likely position to perform the majority of tests - (goto-char indent-point) - (skip-chars-forward " \t") - (setq literal (vhdl-in-literal)) - (setq char-after-ip (following-char)) - (setq begin-after-ip (and - (not literal) - (looking-at vhdl-begin-fwd-re) - (or (not (looking-at "\\<use\\>")) - (save-excursion - (back-to-indentation) - (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) - (vhdl-begin-p))) - (setq end-after-ip (and - (not literal) - (looking-at vhdl-end-fwd-re) - (vhdl-end-p))) - (vhdl-backward-syntactic-ws lim) - (setq char-before-ip (preceding-char)) - (goto-char indent-point) - (skip-chars-forward " \t") - - ;; now figure out syntactic qualities of the current line - (cond - ;; CASE 1: in a string or comment. - ((memq literal '(string comment)) - (vhdl-add-syntax literal (vhdl-point 'bopl))) - ;; CASE 2: Line is at top level. - ((null containing-sexp) - ;; Find the point to which indentation will be relative - (save-excursion - (if (null preceding-sexp) - ;; CASE 2X.1 - ;; no preceding-sexp -> use the preceding statement - (vhdl-beginning-of-statement-1 lim) - ;; CASE 2X.2 - ;; if there is a preceding-sexp then indent relative to it - (goto-char preceding-sexp) - ;; if not at boi, then the block-opening keyword is - ;; probably following a label, so we need a different - ;; relpos - (if (/= (point) (vhdl-point 'boi)) - ;; CASE 2X.3 - (vhdl-beginning-of-statement-1 lim))) - ;; v-b-o-s could have left us at point-min - (and (bobp) - ;; CASE 2X.4 - (vhdl-forward-syntactic-ws indent-point)) - (setq placeholder (point))) - (cond - ;; CASE 2A : we are looking at a block-open - (begin-after-ip - (vhdl-add-syntax 'block-open placeholder)) - ;; CASE 2B: we are looking at a block-close - (end-after-ip - (vhdl-add-syntax 'block-close placeholder)) - ;; CASE 2C: we are looking at a top-level statement - ((progn - (vhdl-backward-syntactic-ws lim) - (or (bobp) - (and (= (preceding-char) ?\;) - (not (vhdl-in-quote-p))))) - (vhdl-add-syntax 'statement placeholder)) - ;; CASE 2D: we are looking at a top-level statement-cont - (t - (vhdl-beginning-of-statement-1 lim) - ;; v-b-o-s could have left us at point-min - (and (bobp) - ;; CASE 2D.1 - (vhdl-forward-syntactic-ws indent-point)) - (vhdl-add-syntax 'statement-cont (point))) - )) ; end CASE 2 - ;; CASE 3: line is inside parentheses. Most likely we are - ;; either in a subprogram argument (interface) list, or a - ;; continued expression containing parentheses. - ((null containing-begin) - (vhdl-backward-syntactic-ws containing-sexp) - (cond - ;; CASE 3A: we are looking at the arglist closing paren - ((eq char-after-ip ?\)) - (goto-char containing-sexp) - (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) - ;; CASE 3B: we are looking at the first argument in an empty - ;; argument list. - ((eq char-before-ip ?\() - (goto-char containing-sexp) - (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) - ;; CASE 3C: we are looking at an arglist continuation line, - ;; but the preceding argument is on the same line as the - ;; opening paren. This case includes multi-line - ;; expression paren groupings. - ((and (save-excursion - (goto-char (1+ containing-sexp)) - (skip-chars-forward " \t") - (not (eolp)) - (not (looking-at "--\\|`"))) - (save-excursion - (vhdl-beginning-of-statement-1 containing-sexp) - (skip-chars-backward " \t(") - (while (and (= (preceding-char) ?\;) - (not (vhdl-in-quote-p))) - (vhdl-beginning-of-statement-1 containing-sexp) - (skip-chars-backward " \t(")) - (<= (point) containing-sexp))) - (goto-char containing-sexp) - (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) - ;; CASE 3D: we are looking at just a normal arglist - ;; continuation line - (t (vhdl-beginning-of-statement-1 containing-sexp) - (vhdl-forward-syntactic-ws indent-point) - (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) - )) - ;; CASE 4: A block mid open - ((and begin-after-ip - (looking-at containing-mid)) - (goto-char containing-sexp) - ;; If the \"begin\" keyword is a trailer, then find v-b-o-s - (if (looking-at vhdl-trailer-re) - ;; CASE 4.1 - (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) - (vhdl-backward-skip-label (vhdl-point 'boi)) - (vhdl-add-syntax 'block-open (point))) - ;; CASE 5: block close brace - (end-after-ip - (goto-char containing-sexp) - ;; If the \"begin\" keyword is a trailer, then find v-b-o-s - (if (looking-at vhdl-trailer-re) - ;; CASE 5.1 - (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) - (vhdl-backward-skip-label (vhdl-point 'boi)) - (vhdl-add-syntax 'block-close (point))) - ;; CASE 6: A continued statement - ((and (/= char-before-ip ?\;) - ;; check it's not a trailer begin keyword, or a begin - ;; keyword immediately following a label. - (not (and begin-after-ip - (or (looking-at vhdl-trailer-re) - (save-excursion - (vhdl-backward-skip-label containing-sexp))))) - ;; check it's not a statement keyword - (not (and (looking-at vhdl-statement-fwd-re) - (vhdl-statement-p))) - ;; see if the b-o-s is before the indent point - (> indent-point - (save-excursion - (vhdl-beginning-of-statement-1 containing-sexp) - ;; If we ended up after a leader, then this will - ;; move us forward to the start of the first - ;; statement. Note that a containing sexp here is - ;; always a keyword, not a paren, so this will - ;; have no effect if we hit the containing-sexp. - (vhdl-forward-syntactic-ws indent-point) - (setq placeholder (point)))) - ;; check it's not a block-intro - (/= placeholder containing-sexp) - ;; check it's not a case block-intro - (save-excursion - (goto-char placeholder) - (or (not (looking-at vhdl-case-alternative-re)) - (> (match-end 0) indent-point)))) - ;; Make placeholder skip a label, but only if it puts us - ;; before the indent point at the start of a line. - (let ((new placeholder)) - (if (and (> indent-point - (save-excursion - (goto-char placeholder) - (vhdl-forward-skip-label indent-point) - (setq new (point)))) - (save-excursion - (goto-char new) - (eq new (progn (back-to-indentation) (point))))) - (setq placeholder new))) - (vhdl-add-syntax 'statement-cont placeholder) - (if begin-after-ip - (vhdl-add-syntax 'block-open))) - ;; Statement. But what kind? - ;; CASE 7: A case alternative key - ((and (looking-at vhdl-case-alternative-re) - (vhdl-case-alternative-p containing-sexp)) - ;; for a case alternative key, we set relpos to the first - ;; non-whitespace char on the line containing the "case" - ;; keyword. - (goto-char containing-sexp) - ;; If the \"begin\" keyword is a trailer, then find v-b-o-s - (if (looking-at vhdl-trailer-re) - (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) - (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) - ;; CASE 8: statement catchall - (t - ;; we know its a statement, but we need to find out if it is - ;; the first statement in a block - (if containing-leader - (goto-char containing-leader) - (goto-char containing-sexp) - ;; Note that a containing sexp here is always a keyword, - ;; not a paren, so skip over the keyword. - (forward-sexp)) - ;; move to the start of the first statement - (vhdl-forward-syntactic-ws indent-point) - (setq placeholder (point)) - ;; we want to ignore case alternatives keys when skipping forward - (let (incase-p) - (while (looking-at vhdl-case-alternative-re) - (setq incase-p (point)) - ;; we also want to skip over the body of the - ;; case/when statement if that doesn't put us at - ;; after the indent-point - (while (vhdl-skip-case-alternative indent-point)) - ;; set up the match end - (looking-at vhdl-case-alternative-re) - (goto-char (match-end 0)) - ;; move to the start of the first case alternative statement - (vhdl-forward-syntactic-ws indent-point) - (setq placeholder (point))) - (cond - ;; CASE 8A: we saw a case/when statement so we must be - ;; in a switch statement. find out if we are at the - ;; statement just after a case alternative key - ((and incase-p - (= (point) indent-point)) - ;; relpos is the "when" keyword - (vhdl-add-syntax 'statement-case-intro incase-p)) - ;; CASE 8B: any old statement - ((< (point) indent-point) - ;; relpos is the first statement of the block - (vhdl-add-syntax 'statement placeholder) - (if begin-after-ip - (vhdl-add-syntax 'block-open))) - ;; CASE 8C: first statement in a block - (t - (goto-char containing-sexp) - ;; If the \"begin\" keyword is a trailer, then find v-b-o-s - (if (looking-at vhdl-trailer-re) - (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) - (vhdl-backward-skip-label (vhdl-point 'boi)) - (vhdl-add-syntax 'statement-block-intro (point)) - (if begin-after-ip - (vhdl-add-syntax 'block-open))) - ))) - ) - - ;; now we need to look at any modifiers - (goto-char indent-point) - (skip-chars-forward " \t") - (if (or (looking-at "--") (looking-at "/\\*")) - (vhdl-add-syntax 'comment)) - (if (looking-at "`") - (vhdl-add-syntax 'directive)) - (if (eq literal 'pound) - (vhdl-add-syntax 'cpp-macro)) - ;; return the syntax - vhdl-syntactic-context)))) - -;; Standard indentation line-ups: - -(defun vhdl-lineup-arglist (langelem) - "Lineup the current arglist line with the arglist appearing just -after the containing paren which starts the arglist." - (save-excursion - (let* ((containing-sexp - (save-excursion - ;; arglist-cont-nonempty gives relpos == - ;; to boi of containing-sexp paren. This - ;; is good when offset is +, but bad - ;; when it is vhdl-lineup-arglist, so we - ;; have to special case a kludge here. - (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) - (progn - (beginning-of-line) - (backward-up-list 1) - (skip-chars-forward " \t" (vhdl-point 'eol))) - (goto-char (cdr langelem))) - (point))) - (cs-curcol (save-excursion - (goto-char (cdr langelem)) - (current-column)))) - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*)")) - (progn (goto-char (match-end 0)) - (backward-sexp) - (forward-char) - (vhdl-forward-syntactic-ws) - (- (current-column) cs-curcol)) - (goto-char containing-sexp) - (or (eolp) - (let ((eol (vhdl-point 'eol)) - (here (progn - (forward-char) - (skip-chars-forward " \t") - (point)))) - (vhdl-forward-syntactic-ws) - (if (< (point) eol) - (goto-char here)))) - (- (current-column) cs-curcol) - )))) - -(defun vhdl-lineup-arglist-intro (langelem) - "Lineup an arglist-intro line to just after the open paren." - (save-excursion - (let ((cs-curcol (save-excursion - (goto-char (cdr langelem)) - (current-column))) - (ce-curcol (save-excursion - (beginning-of-line) - (backward-up-list 1) - (skip-chars-forward " \t" (vhdl-point 'eol)) - (current-column)))) - (- ce-curcol cs-curcol -1)))) - -(defun vhdl-lineup-comment (_langelem) - "Support old behavior for comment indentation. -We look at `vhdl-comment-only-line-offset' to decide how to -indent comment only-lines." - (save-excursion - (back-to-indentation) - ;; at or to the right of comment-column - (if (>= (current-column) comment-column) - (vhdl-comment-indent) - ;; otherwise, indent as specified by vhdl-comment-only-line-offset - (if (not (bolp)) - ;; inside multi-line comment - (if (looking-at "\\*") - 1 - ;; otherwise - (or (car-safe vhdl-comment-only-line-offset) - vhdl-comment-only-line-offset)) - (or (cdr-safe vhdl-comment-only-line-offset) - (car-safe vhdl-comment-only-line-offset) - -1000 ;jam it against the left side - ))))) - -(defun vhdl-lineup-statement-cont (langelem) - "Line up statement-cont after the assignment operator." - (save-excursion - (let* ((relpos (cdr langelem)) - (assignp (save-excursion - (goto-char (vhdl-point 'boi)) - (and (re-search-forward "\\(<\\|:\\|=\\)=" - (vhdl-point 'eol) t) - (- (point) (vhdl-point 'boi))))) - (curcol (progn - (goto-char relpos) - (current-column))) - foundp) - (while (and (not foundp) - (< (point) (vhdl-point 'eol))) - (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move) - (if (vhdl-in-literal) - (forward-char) - (if (= (preceding-char) ?\() - ;; skip over any parenthesized expressions - (goto-char (min (vhdl-point 'eol) - (scan-lists (point) 1 1))) - ;; found an assignment operator (not at eol) - (setq foundp (not (looking-at "\\s-*$")))))) - (if (not foundp) - ;; there's no assignment operator on the line - vhdl-basic-offset - ;; calculate indentation column after assign and ws, unless - ;; our line contains an assignment operator - (if (not assignp) - (progn - (forward-char) - (skip-chars-forward " \t") - (setq assignp 0))) - (- (current-column) assignp curcol)) - ))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Progress reporting - -(defvar vhdl--progress-reporter nil - "Holds the progress reporter data during long running operations.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Indentation commands - -(defun vhdl-electric-tab (&optional arg) - "If preceding character is part of a word or a paren then hippie-expand, -else if right of non whitespace on line then insert tab, -else if last command was a tab or return then dedent one step or if a comment -toggle between normal indent and inline comment indent, -else indent `correctly'." - (interactive "*P") - (vhdl-prepare-search-2 - (cond - ;; indent region if region is active - ((and (not (featurep 'xemacs)) (use-region-p)) - (indent-region (region-beginning) (region-end) nil)) - ;; expand word - ((= (char-syntax (preceding-char)) ?w) - (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) - (case-replace nil) - (hippie-expand-only-buffers - (or (and (boundp 'hippie-expand-only-buffers) - hippie-expand-only-buffers) - '(vhdl-mode)))) - (vhdl-expand-abbrev arg))) - ;; expand parenthesis - ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) - (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) - (case-replace nil)) - (vhdl-expand-paren arg))) - ;; insert tab - ((> (current-column) (current-indentation)) - (insert-tab)) - ;; toggle comment indent - ((and (looking-at "--") - (or (eq last-command 'vhdl-electric-tab) - (eq last-command 'vhdl-electric-return))) - (cond ((= (current-indentation) 0) ; no indent - (indent-to 1) - (indent-according-to-mode)) - ((< (current-indentation) comment-column) ; normal indent - (indent-to comment-column) - (indent-according-to-mode)) - (t ; inline comment indent - (delete-region (line-beginning-position) (point))))) - ;; dedent - ((and (>= (current-indentation) vhdl-basic-offset) - (or (eq last-command 'vhdl-electric-tab) - (eq last-command 'vhdl-electric-return))) - (backward-delete-char-untabify vhdl-basic-offset nil)) - ;; indent line - (t (indent-according-to-mode))) - (setq this-command 'vhdl-electric-tab))) - -(defun vhdl-electric-return () - "`newline-and-indent' or `indent-new-comment-line' if in comment and preceding -character is a space." - (interactive) - (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) - (indent-new-comment-line) - (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z) - (not (vhdl-in-comment-p))) - (vhdl-fix-case-word -1)) - (newline-and-indent))) - -(defun vhdl-indent-line () - "Indent the current line as VHDL code. -Return the amount of indentation change." - (interactive) - (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) - (pos (- (point-max) (point))) - (is-comment nil) - (indent - (if syntax - ;; indent syntax-based - (if (and (eq (caar syntax) 'comment) - (>= (vhdl-get-offset (car syntax)) comment-column)) - ;; special case: comments at or right of comment-column - (vhdl-get-offset (car syntax)) - ;; align comments like following code line - (when vhdl-indent-comment-like-next-code-line - (save-excursion - (while (eq (caar syntax) 'comment) - (setq is-comment t) - (beginning-of-line 2) - (setq syntax (vhdl-get-syntactic-context))))) - (when is-comment - (push (cons 'comment nil) syntax)) - (apply #'+ (mapcar #'vhdl-get-offset syntax))) - ;; indent like previous nonblank line - (save-excursion (beginning-of-line) - (re-search-backward "^[^\n]" nil t) - (current-indentation)))) - (shift-amt (- indent (current-indentation)))) - (and vhdl-echo-syntactic-information-p - (message "syntax: %s, indent= %d" syntax indent)) - (let ((has-formfeed - (save-excursion (beginning-of-line) (looking-at "\\s-*\f")))) - (when (or (not (zerop shift-amt)) has-formfeed) - (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) - (beginning-of-line) - (when has-formfeed (insert "\f")) - (indent-to indent))) - (if (< (point) (vhdl-point 'boi)) - (back-to-indentation) - ;; If initial point was within line's indentation, position after - ;; the indentation. Else stay at same point in text. - (when (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))) - (run-hooks 'vhdl-special-indent-hook) - (when vhdl--progress-reporter - (progress-reporter-update vhdl--progress-reporter (point))) - shift-amt)) - -(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1") - -(defun vhdl-indent-buffer () - "Indent whole buffer as VHDL code. -Calls `indent-region' for whole buffer and adds progress reporting." - (interactive) - (indent-region (point-min) (point-max))) - -(defun vhdl-indent-group () - "Indent group of lines between empty lines." - (interactive) - (let ((beg (save-excursion - (if (re-search-backward vhdl-align-group-separate nil t) - (point-marker) - (point-min-marker)))) - (end (save-excursion - (if (re-search-forward vhdl-align-group-separate nil t) - (point-marker) - (point-max-marker))))) - (indent-region beg end))) - -(defun vhdl-indent-sexp (&optional endpos) - "Indent each line of the list starting just after point. -If optional arg ENDPOS is given, indent each line, stopping when -ENDPOS is encountered." - (interactive) - (save-excursion - (let ((beg (point)) - (end (progn (vhdl-forward-sexp nil endpos) (point)))) - (indent-region beg end nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous commands - -(defun vhdl-show-syntactic-information () - "Show syntactic information for current line." - (interactive) - (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) - (vhdl-keep-region-active)) - -;; Verification and regression functions: - -(defun vhdl-regress-line (&optional arg) - "Check syntactic information for current line." - (interactive "P") - (let ((expected (save-excursion - (end-of-line) - (when (search-backward " -- ((" (vhdl-point 'bol) t) - (forward-char 4) - (read (current-buffer))))) - (actual (vhdl-get-syntactic-context)) - (expurgated)) - ;; remove the library unit symbols - (mapc - (lambda (elt) - (if (memq (car elt) '(entity configuration context package - package-body architecture)) - nil - (setq expurgated (append expurgated (list elt))))) - actual) - (if (and (not arg) expected (listp expected)) - (if (not (equal expected expurgated)) - (error "ERROR: Should be: %s, is: %s" expected expurgated)) - (save-excursion - (beginning-of-line) - (when (not (looking-at "^\\s-*\\(--.*\\)?$")) - (end-of-line) - (if (search-backward " -- ((" (vhdl-point 'bol) t) - (delete-region (point) (line-end-position))) - (insert " -- ") - (insert (format "%s" expurgated)))))) - (vhdl-keep-region-active)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Alignment, beautifying -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vhdl-align-alist - '( - ;; after some keywords - (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]" - "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2) - ;; before ':' - (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") - ;; after direction specifications - (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" - ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) - ;; before "==", ":=", "=>", and "<=" - (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur - (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) - (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur - ;; before some keywords - (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) - (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) - (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) - (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1) - (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1) - ;; before "=>" since "when/else ... =>" can occur - (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) - ) - "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). -It is searched in order. If REGEXP is found anywhere in the first -line of a region to be aligned, ALIGN-PATTERN will be used for that -region. ALIGN-PATTERN must include the whitespace to be expanded or -contracted. It may also provide regexps for the text surrounding the -whitespace. SUBEXP specifies which sub-expression of -ALIGN-PATTERN matches the white space to be expanded/contracted.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Align code - -(defvar vhdl-align-try-all-clauses t - "If REGEXP is not found on the first line of the region that clause is ignored. -If this variable is non-nil, then the clause is tried anyway.") - -(defun vhdl-do-group (function &optional spacing) - "Apply FUNCTION on group of lines between empty lines." - (let - ;; search for group beginning - ((beg (save-excursion - (if (re-search-backward vhdl-align-group-separate nil t) - (progn (beginning-of-line 2) (back-to-indentation) (point)) - (point-min)))) - ;; search for group end - (end (save-excursion - (if (re-search-forward vhdl-align-group-separate nil t) - (progn (beginning-of-line) (point)) - (point-max))))) - ;; run FUNCTION - (funcall function beg end spacing))) - -(defun vhdl-do-list (function &optional spacing) - "Apply FUNCTION to lines of a list surrounded by a balanced group of parentheses." - (let (beg end) - (save-excursion - ;; search for beginning of balanced group of parentheses - (setq beg (vhdl-re-search-backward "[()]" nil t)) - (while (looking-at ")") - (forward-char) (backward-sexp) - (setq beg (vhdl-re-search-backward "[()]" nil t))) - ;; search for end of balanced group of parentheses - (when beg - (forward-list) - (setq end (point)) - (goto-char (1+ beg)) - (skip-chars-forward " \t\n\r\f") - (setq beg (point)))) - ;; run FUNCTION - (if beg - (funcall function beg end spacing) - (error "ERROR: Not within a list enclosed by a pair of parentheses")))) - -(defun vhdl-do-same-indent (function &optional spacing) - "Apply FUNCTION to block of lines with same indent." - (let ((indent (current-indentation)) - beg end) - ;; search for first line with same indent - (save-excursion - (while (and (not (bobp)) - (or (looking-at "^\\s-*\\(--.*\\)?$") - (= (current-indentation) indent))) - (unless (looking-at "^\\s-*$") - (back-to-indentation) (setq beg (point))) - (beginning-of-line -0))) - ;; search for last line with same indent - (save-excursion - (while (and (not (eobp)) - (or (looking-at "^\\s-*\\(--.*\\)?$") - (= (current-indentation) indent))) - (if (looking-at "^\\s-*$") - (beginning-of-line 2) - (beginning-of-line 2) - (setq end (point))))) - ;; run FUNCTION - (funcall function beg end spacing))) - -(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent) - "Attempt to align a range of lines based on the content of the lines. -The definition of `alignment-list' determines the matching order -and the manner in which the lines are aligned. If ALIGNMENT-LIST -is not specified `vhdl-align-alist' is used. If INDENT is -non-nil, indentation is done before aligning." - (interactive "r\np") - (setq alignment-list (or alignment-list vhdl-align-alist)) - (setq spacing (or spacing 1)) - (save-excursion - (let (bol) ;; indent - (goto-char end) - (setq end (point-marker)) - (goto-char begin) - (setq bol (setq begin (progn (beginning-of-line) (point)))) - ;; FIXME: The `indent' arg is not used, and I think it's because - ;; the let binding commented out above `indent' was hiding it, so - ;; the test below should maybe still test `indent'? - (when nil ;; indent - (indent-region bol end nil)))) - (let ((copy (copy-alist alignment-list))) - (vhdl-prepare-search-2 - (while copy - (save-excursion - (goto-char begin) - (let (element - (eol (line-end-position))) - (setq element (nth 0 copy)) - (when (and (or (and (listp (car element)) - (memq major-mode (car element))) - (eq major-mode (car element))) - (or vhdl-align-try-all-clauses - (re-search-forward (car (cdr element)) eol t))) - (vhdl-align-region-2 begin end (car (cdr (cdr element))) - (car (cdr (cdr (cdr element)))) spacing)) - (setq copy (cdr copy)))))))) - -(defun vhdl-align-region-2 (begin end match &optional substr spacing) - "Align a range of lines from BEGIN to END. -The regular expression MATCH must match exactly one field: the -whitespace to be contracted/expanded. The alignment column will -equal the rightmost column of the widest whitespace block. -SPACING is the amount of extra spaces to add to the calculated -maximum required. SPACING defaults to 1 so that at least one -space is inserted after the token in MATCH." - (setq spacing (or spacing 1)) - (setq substr (or substr 1)) - (save-excursion - (let (distance (max 0) (lines 0) bol eol width) - ;; Determine the greatest whitespace distance to the alignment - ;; character - (goto-char begin) - (setq eol (line-end-position) - bol (setq begin (progn (beginning-of-line) (point)))) - (while (< bol end) - (save-excursion - (when (and (vhdl-re-search-forward match eol t) - (save-excursion - (goto-char (match-beginning 0)) - (forward-char) - (and (not (vhdl-in-literal)) - (not (vhdl-in-quote-p)) - (not (vhdl-in-extended-identifier-p)))) - (not (looking-at "\\s-*$"))) - (setq distance (- (match-beginning substr) bol)) - (when (> distance max) - (setq max distance)))) - (forward-line) - (setq bol (point) - eol (line-end-position)) - (setq lines (1+ lines))) - ;; Now insert enough maxs to push each assignment operator to - ;; the same column. We need to use 'lines' as a counter, since - ;; the location of the mark may change - (goto-char (setq bol begin)) - (setq eol (line-end-position)) - (while (> lines 0) - (when (and (vhdl-re-search-forward match eol t) - (save-excursion - (goto-char (match-beginning 0)) - (forward-char) - (and (not (vhdl-in-literal)) - (not (vhdl-in-quote-p)) - (not (vhdl-in-extended-identifier-p)))) - (not (looking-at "\\s-*$")) - (> (match-beginning 0) ; not if at boi - (save-excursion (back-to-indentation) (point)))) - (setq width (- (match-end substr) (match-beginning substr))) - (setq distance (- (match-beginning substr) bol)) - (goto-char (match-beginning substr)) - (delete-char width) - (insert-char ? (+ (- max distance) spacing))) - (beginning-of-line) - (forward-line) - (setq bol (point) - eol (line-end-position)) - (setq lines (1- lines)))))) - -(defun vhdl-align-region-groups (beg end &optional spacing - no-message no-comments) - "Align region, treat groups of lines separately." - (interactive "r\nP") - (save-excursion - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - (goto-char end) - (setq end (point-marker)) - (untabify beg end) - (let ((orig (copy-marker beg)) - pos - (vhdl--progress-reporter - (if no-message - ;; Preserve a potential progress reporter from - ;; when called from `vhdl-align-region' call. - vhdl--progress-reporter - (when vhdl-progress-interval - (make-progress-reporter "Aligning..." beg (copy-marker end)))))) - (when (nth 0 vhdl-beautify-options) - (vhdl-fixup-whitespace-region beg end t)) - (goto-char beg) - (if (not vhdl-align-groups) - ;; align entire region - (progn (vhdl-align-region-1 beg end spacing) - (unless no-comments - (vhdl-align-inline-comment-region-1 beg end))) - ;; align groups - (while (and (< beg end) - (re-search-forward vhdl-align-group-separate end t)) - (setq pos (point-marker)) - (vhdl-align-region-1 beg pos spacing) - (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) - (when vhdl--progress-reporter - (progress-reporter-update vhdl--progress-reporter (point))) - (setq beg (1+ pos)) - (goto-char beg)) - ;; align last group - (when (< beg end) - (vhdl-align-region-1 beg end spacing) - (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) - (when vhdl--progress-reporter - (progress-reporter-update vhdl--progress-reporter (point))))) - (when vhdl-indent-tabs-mode - (tabify orig end)) - (unless no-message - (when vhdl--progress-reporter - (progress-reporter-done vhdl--progress-reporter)))))) - -(defun vhdl-align-region (beg end &optional spacing) - "Align region, treat blocks with same indent and argument lists separately." - (interactive "r\nP") - (if (not vhdl-align-same-indent) - ;; align entire region - (vhdl-align-region-groups beg end spacing) - ;; align blocks with same indent and argument lists - (save-excursion - (let ((cur-beg beg) - indent cur-end - (vhdl--progress-reporter - (when vhdl-progress-interval - (make-progress-reporter "Aligning..." beg (copy-marker end))))) - (goto-char end) - (setq end (point-marker)) - (goto-char cur-beg) - (while (< (point) end) - ;; is argument list opening? - (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp - (point) (vhdl-point 'eol))))) - ;; determine region for argument list - (progn (goto-char cur-beg) - (forward-sexp) - (setq cur-end (point)) - (beginning-of-line 2)) - ;; determine region with same indent - (setq indent (current-indentation)) - (setq cur-beg (point)) - (setq cur-end (vhdl-point 'bonl)) - (beginning-of-line 2) - (while (and (< (point) end) - (or (looking-at "^\\s-*\\(--.*\\)?$") - (= (current-indentation) indent)) - (<= (save-excursion - (nth 0 (parse-partial-sexp - (point) (vhdl-point 'eol)))) - 0)) - (unless (looking-at "^\\s-*$") - (setq cur-end (vhdl-point 'bonl))) - (beginning-of-line 2))) - ;; align region - (vhdl-align-region-groups cur-beg cur-end spacing t t)) - (vhdl-align-inline-comment-region beg end spacing noninteractive) - (when vhdl--progress-reporter - (progress-reporter-done vhdl--progress-reporter)))))) - -(defun vhdl-align-group (&optional spacing) - "Align group of lines between empty lines." - (interactive) - (vhdl-do-group 'vhdl-align-region spacing)) - -(defun vhdl-align-list (&optional spacing) - "Align the lines of a list surrounded by a balanced group of parentheses." - (interactive) - (vhdl-do-list 'vhdl-align-region-groups spacing)) - -(defun vhdl-align-same-indent (&optional spacing) - "Align block of lines with same indent." - (interactive) - (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) - -(defun vhdl-align-declarations (&optional spacing) - "Align the lines within the declarative part of a design unit." - (interactive) - (let (beg end) - (vhdl-prepare-search-2 - (save-excursion - ;; search for declarative part - (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t) - (not (member (upcase (match-string 1)) '("BEGIN" "END")))) - (setq beg (point)) - (re-search-forward "^\\(begin\\|end\\)\\>" nil t) - (setq end (point))))) - (if beg - (vhdl-align-region-groups beg end spacing) - (error "ERROR: Not within the declarative part of a design unit")))) - -(defun vhdl-align-buffer () - "Align buffer." - (interactive) - (vhdl-align-region (point-min) (point-max))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Align inline comments - -(defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) - "Align inline comments in region." - (save-excursion - (let ((start-max comment-column) - (length-max 0) - comment-list start-list tmp-list start length - cur-start prev-start no-code) - (setq spacing (or spacing 2)) - (vhdl-prepare-search-2 - (goto-char beg) - ;; 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-*\\(--.*\\)$") - (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)) - (push (cons start length) comment-list)) - (beginning-of-line 2)) - (setq comment-list - (sort comment-list (lambda (a b) (> (car a) (car b))))) - ;; reduce start positions - (setq start-list (list (caar comment-list))) - (setq comment-list (cdr comment-list)) - (while comment-list - (unless (or (= (caar comment-list) (car start-list)) - (<= (+ (car start-list) (cdar comment-list)) - end-comment-column)) - (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-*\\)\\(--.*\\)$") - (not (save-excursion - (goto-char (match-beginning 3)) - (vhdl-in-literal)))) - (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") - (>= (- (match-end 2) (match-beginning 2)) - comment-column)))) - (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) - (setq length (- (match-end 3) (match-beginning 3))) - (setq no-code (= (match-beginning 1) (match-end 1))) - ;; insert minimum whitespace - (goto-char (match-end 2)) - (delete-region (match-beginning 2) (match-end 2)) - (insert-char ?\ spacing) - (setq tmp-list start-list) - ;; insert additional whitespace to align - (setq cur-start - (cond - ;; align comment-only line to inline comment of previous line - ((and no-code prev-start - (<= length (- end-comment-column prev-start))) - prev-start) - ;; align all comments at `start-max' if this is possible - ((<= (+ start-max length-max) end-comment-column) - start-max) - ;; align at `comment-column' if possible - ((and (<= start comment-column) - (<= length (- end-comment-column comment-column))) - comment-column) - ;; align at left-most possible start position otherwise - (t - (while (and tmp-list (< (car tmp-list) start)) - (setq tmp-list (cdr tmp-list))) - (car tmp-list)))) - (indent-to cur-start)) - (setq prev-start cur-start) - (beginning-of-line 2)))))) - -(defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) - "Align inline comments within a region. -Groups of code lines separated by empty lines are aligned -individually, if `vhdl-align-groups' is non-nil." - (interactive "r\nP") - (save-excursion - (let (orig pos) - (goto-char beg) - (beginning-of-line) - (setq orig (point-marker)) - (setq beg (point)) - (goto-char end) - (setq end (point-marker)) - (untabify beg end) - (unless no-message (message "Aligning inline comments...")) - (goto-char beg) - (if (not vhdl-align-groups) - ;; align entire region - (vhdl-align-inline-comment-region-1 beg end spacing) - ;; align groups - (while (and (< beg end) - (re-search-forward vhdl-align-group-separate end t)) - (setq pos (point-marker)) - (vhdl-align-inline-comment-region-1 beg pos spacing) - (setq beg (1+ pos)) - (goto-char beg)) - ;; align last group - (when (< beg end) - (vhdl-align-inline-comment-region-1 beg end spacing))) - (when vhdl-indent-tabs-mode - (tabify orig end)) - (unless no-message (message "Aligning inline comments...done"))))) - -(defun vhdl-align-inline-comment-group (&optional _spacing) - "Align inline comments within a group of lines between empty lines." - (interactive) - (save-excursion - (let ((start (point)) - beg end) - (setq end (if (re-search-forward vhdl-align-group-separate nil t) - (point-marker) (point-max))) - (goto-char start) - (setq beg (if (re-search-backward vhdl-align-group-separate nil t) - (point) (point-min))) - (untabify beg end) - (message "Aligning inline comments...") - (vhdl-align-inline-comment-region-1 beg end) - (when vhdl-indent-tabs-mode - (tabify beg end)) - (message "Aligning inline comments...done")))) - -(defun vhdl-align-inline-comment-buffer () - "Align inline comments within buffer. -Groups of code lines separated by empty lines are aligned -individually, if `vhdl-align-groups' is non-nil." - (interactive) - (vhdl-align-inline-comment-region (point-min) (point-max))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Fixup whitespace - -(defun vhdl-fixup-whitespace-region (beg end &optional no-message) - "Fixup whitespace in region. -Surround operator symbols by one space, eliminate multiple -spaces (except at beginning of line), eliminate spaces at end of -line, do nothing in comments and strings." - (interactive "r") - (unless no-message (message "Fixing up whitespace...")) - (save-excursion - (goto-char end) - (setq end (point-marker)) - ;; have no space before and one space after `,' and ';' - (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) - (if (match-string 1) - (goto-char (match-end 1)) - (replace-match "\\3 " nil nil nil 2))) - ;; have no space after `(' - (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t) - (if (match-string 1) - (goto-char (match-end 1)) - (replace-match "\\2"))) - ;; have no space before `)' - (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) - (if (match-string 1) - (goto-char (match-end 1)) - (replace-match "\\2"))) - ;; surround operator symbols by one space - (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) - (if (or (match-string 1) - (<= (match-beginning 0) ; not if at boi - (save-excursion (back-to-indentation) (point)))) - (goto-char (match-end 0)) - (replace-match "\\3 \\4 \\5") - (goto-char (match-end 2)))) - ;; eliminate multiple spaces and spaces at end of line - (goto-char beg) - (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) - (and (looking-at "--.*") (re-search-forward "--.*" end t)) - (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) - (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) - (progn (replace-match "" nil nil) t)) - (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) - (progn (replace-match ";" nil nil) t)) - (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) - (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) - (progn (replace-match " " nil nil) t)) - (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)))) - (unless no-message (message "Fixing up whitespace...done"))) - -(defun vhdl-fixup-whitespace-buffer () - "Fixup whitespace in buffer. -Surround operator symbols by one space, eliminate multiple -spaces (except at beginning of line), eliminate spaces at end of -line, do nothing in comments." - (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) - (pr (when (and count vhdl-progress-interval (not noninteractive)) - (make-progress-reporter "Fixing case..." beg (copy-marker end))))) - (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 pr (progress-reporter-update pr (point)))) - (when pr (progress-reporter-done pr)))))) - -(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") - (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") - (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") - (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 - -(defun vhdl-beautify-region (beg end) - "Beautify region by applying indentation, whitespace fixup, alignment, and -case fixing to a region. Calls functions `vhdl-indent-buffer', -`vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and -`vhdl-fix-case-buffer'." - (interactive "r") - (setq end (save-excursion (goto-char end) (point-marker))) - (save-excursion ; remove DOS EOL characters in UNIX file - (goto-char beg) - (while (search-forward "\r" nil t) - (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) (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 -case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire -buffer." - (interactive) - (vhdl-beautify-region (point-min) (point-max)) - (when noninteractive (save-buffer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Code filling - -(defun vhdl-fill-region (beg end &optional arg) - "Fill lines for a region of code." - (interactive "r\np") - (save-excursion - (goto-char beg) - (let ((margin (if arg (current-indentation) (current-column)))) - (goto-char end) - (setq end (point-marker)) - ;; remove inline comments, newlines and whitespace - (vhdl-comment-kill-region beg end) - (vhdl-comment-kill-inline-region beg end) - (subst-char-in-region beg (1- end) ?\n ?\ ) - (vhdl-fixup-whitespace-region beg end) - ;; wrap and end-comment-column - (goto-char beg) - (while (re-search-forward "\\s-" end t) - (when(> (current-column) vhdl-end-comment-column) - (backward-char) - (when (re-search-backward "\\s-" beg t) - (replace-match "\n") - (indent-to margin))))))) - -(defun vhdl-fill-group () - "Fill group of lines between empty lines." - (interactive) - (vhdl-do-group 'vhdl-fill-region)) - -(defun vhdl-fill-list () - "Fill the lines of a list surrounded by a balanced group of parentheses." - (interactive) - (vhdl-do-list 'vhdl-fill-region)) - -(defun vhdl-fill-same-indent () - "Fill the lines of block of lines with same indent." - (interactive) - (vhdl-do-same-indent 'vhdl-fill-region)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code updating/fixing -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sensitivity list update - -;; Strategy: -;; - no sensitivity list is generated for processes with wait statements -;; - otherwise, do the following: -;; 1. scan for all local signals (ports, signals declared in arch./blocks) -;; 2. scan for all signals already in the sensitivity list (in order to catch -;; manually entered global signals) -;; 3. signals from 1. and 2. form the list of visible signals -;; 4. search for if/elsif conditions containing an event (sequential code) -;; 5. scan for strings that are within syntactical regions where signals are -;; read but not within sequential code, and that correspond to visible -;; signals -;; 6. replace sensitivity list by list of signals from 5. - -(defun vhdl-update-sensitivity-list-process () - "Update sensitivity list of current process." - (interactive) - (save-excursion - (vhdl-prepare-search-2 - (end-of-line) - ;; look whether in process - (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) - (equal (upcase (match-string 2)) "PROCESS") - (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) - (error "ERROR: Not within a process") - (message "Updating sensitivity list...") - (vhdl-update-sensitivity-list) - (message "Updating sensitivity list...done"))))) - -(defun vhdl-update-sensitivity-list-buffer () - "Update sensitivity list of all processes in current buffer." - (interactive) - (save-excursion - (vhdl-prepare-search-2 - (goto-char (point-min)) - (message "Updating sensitivity lists...") - (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"))) - (when noninteractive (save-buffer))) - -(defun vhdl--re2-region (beg-re end-re) - "Return a function searching for a region delimited by a pair of regexps. -BEG-RE and END-RE are the regexps delimiting the region to search for." - (lambda (proc-end) - (when (vhdl-re-search-forward beg-re proc-end t) - (save-excursion - (vhdl-re-search-forward end-re proc-end t))))) - -(defconst vhdl--signal-regions-functions - (list - ;; right-hand side of signal/variable assignment - ;; (special case: "<=" is relational operator in a condition) - (vhdl--re2-region "[<:]=" - ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") - ;; if condition - (vhdl--re2-region "^\\s-*if\\>" "\\<then\\>") - ;; elsif condition - (vhdl--re2-region "\\<elsif\\>" "\\<then\\>") - ;; while loop condition - (vhdl--re2-region "^\\s-*while\\>" "\\<loop\\>") - ;; exit/next condition - (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") - ;; assert condition - (vhdl--re2-region "\\<assert\\>" "\\(\\<report\\>\\|\\<severity\\>\\|;\\)") - ;; case expression - (vhdl--re2-region "^\\s-*case\\>" "\\<is\\>") - ;; parameter list of procedure call, array index - (lambda (proc-end) - (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) - (forward-char -1) - (save-excursion - (forward-sexp) - (while (looking-at "(") (forward-sexp)) (point))))) - "Define syntactic regions where signals are read. -Each function is called with one arg (a limit for the (forward) search) and -should return either nil or the end position of the region (in which case -point will be set to its beginning).") - -(defun vhdl-update-sensitivity-list () - "Update sensitivity list." - (let ((proc-beg (point)) - (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) - (proc-mid (vhdl-re-search-backward - "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t)) - seq-region-list) - (cond - ;; error if 'begin' keyword missing - ((not (match-string 2)) - (error "ERROR: No 'begin' keyword found")) - ;; search for wait statement (no sensitivity list allowed) - ((progn (goto-char proc-mid) - (vhdl-re-search-forward "\\<wait\\>" proc-end t)) - (error "ERROR: Process with wait statement, sensitivity list not generated")) - ;; combinational process (update sensitivity list) - (t - (let - ;; scan for visible signals - ((visible-list (vhdl-get-visible-signals)) - 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) - (vhdl-re-search-forward "\\<process\\>" proc-mid t) - (if (not (looking-at "[ \t\n\r\f]*(")) - (setq sens-beg (point)) - (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 (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) - (setq sens-list - (cons (downcase (match-string 0)) sens-list)) - (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 (vhdl-re-search-forward "\\<then\\>" proc-end t)) - (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) - (goto-char end) - (backward-word-strictly 1) - (vhdl-forward-sexp) - (push (cons end (point)) seq-region-list) - (beginning-of-line))) - ;; scan for signals read in process - (dolist (scan-fun vhdl--signal-regions-functions) - (goto-char proc-mid) - (while (setq end (funcall scan-fun proc-end)) - (unless (or (vhdl-in-literal) - (and seq-region-list - (let ((tmp-list seq-region-list)) - (while (and tmp-list - (< (point) (caar tmp-list))) - (setq tmp-list (cdr tmp-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)) - ;; 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)) - ;; 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)))))) - ;; update sensitivity list - (goto-char sens-beg) - (if sens-end - (delete-region sens-beg sens-end) - (when read-list - (insert " ()") (backward-char))) - (setq read-list (sort read-list #'string<)) - (when read-list - (setq margin (current-column)) - (insert (car read-list)) - (setq read-list (cdr read-list)) - (while read-list - (insert ",") - (if (<= (+ (current-column) (length (car read-list)) 2) - end-comment-column) - (insert " ") - (insert "\n") (indent-to margin)) - (insert (car read-list)) - (setq read-list (cdr read-list))))))))) - -(defun vhdl-get-visible-signals () - "Get all signals visible in the current block." - (let (beg end signal-list entity-name file-name) - (vhdl-prepare-search-2 - ;; get entity name - (save-excursion - (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) - (not (equal "END" (upcase (match-string 1)))) - (setq entity-name (match-string 2))) - (error "ERROR: Not within an architecture"))) - ;; search for signals declared in entity port clause - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) - (setq file-name - (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) - "." (file-name-extension (buffer-file-name))))) - (vhdl-visit-file - file-name t - (vhdl-prepare-search-2 - (goto-char (point-min)) - (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) - (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) - (when (setq beg (vhdl-re-search-forward - "\\<port[ \t\n\r\f]*(" - (save-excursion - (re-search-forward "^end\\>" nil t)) - t)) - (setq end (save-excursion - (backward-char) (forward-sexp) (point))) - (vhdl-forward-syntactic-ws) - (while (< (point) end) - (when (looking-at "signal[ \t\n\r\f]+") - (goto-char (match-end 0))) - (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)) - (vhdl-forward-syntactic-ws)) - (re-search-forward ";" end 1) - (vhdl-forward-syntactic-ws))))))) - ;; search for signals declared in architecture declarative part - (save-excursion - (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) - (not (equal "END" (upcase (match-string 1)))) - (setq end (re-search-forward "^begin\\>" nil t)))) - (error "ERROR: No architecture declarative part found") - ;; scan for all declared signal and alias names - (goto-char beg) - (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) - (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) - (if (match-string 2) - ;; scan signal name - (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]+\\([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)) - (goto-char (match-end 0)))) - (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\\|\\(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\\|generate\\)\\>" nil t)) - beg) - (setq end (re-search-forward "^\\s-*begin\\>" nil t))) - ;; scan for all declared signal names - (goto-char beg) - (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) - (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) - (if (match-string 2) - ;; scan signal name - (while (looking-at "[ \t\n,]+\\(\\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]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") - (member (downcase (match-string 2)) signal-list)) - (setq signal-list - (cons (downcase (match-string 1)) signal-list)) - (goto-char (match-end 0)))))) - (goto-char beg))) - signal-list))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Generic/port clause fixing - -(defun vhdl-fix-clause-buffer () - "Fix all generic/port clauses in current buffer." - (interactive) - (save-excursion - (vhdl-prepare-search-2 - (goto-char (point-min)) - (message "Fixing generic/port clauses...") - (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t) - (goto-char (match-end 0)) - (condition-case nil (vhdl-fix-clause) (error ""))) - (message "Fixing generic/port clauses...done")))) - -(defun vhdl-fix-clause () - "Fix closing parenthesis within generic/port clause." - (interactive) - (save-excursion - (vhdl-prepare-search-2 - (let ((pos (point)) - beg end) - (end-of-line) - (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)) - (error "ERROR: Not within a generic/port clause") - ;; search for end of clause - (goto-char (match-end 0)) - (setq beg (1- (point))) - (vhdl-forward-syntactic-ws) - (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;") - (goto-char (1- (match-end 0))) - (setq end (point-marker)) - (forward-char) - (vhdl-forward-syntactic-ws)) - (goto-char end) - (when (> pos (line-end-position)) - (error "ERROR: Not within a generic/port clause")) - ;; delete closing parenthesis on separate line (not supported style) - (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) - (vhdl-line-kill) - (vhdl-backward-syntactic-ws) - (setq end (point-marker)) - (insert ";")) - ;; delete superfluous parentheses - (while (progn (goto-char beg) - (condition-case () (forward-sexp) - (error (goto-char (point-max)))) - (< (point) end)) - (delete-char -1)) - ;; add closing parenthesis - (when (> (point) end) - (goto-char end) - (insert ")"))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Electrification -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" - "Syntax of prompt inserted by template generators.") - -(defvar vhdl-template-invoked-by-hook nil - "Indicates whether a template has been invoked by a hook or by key or menu. -Used for undoing after template abortion.") - -;; correct different behavior of function `unread-command-events' in XEmacs -(defun vhdl-character-to-event (_arg) nil) -(defalias 'vhdl-character-to-event - (if (fboundp 'character-to-event) #'character-to-event #'identity)) - -(defun vhdl-work-library () - "Return the working library name of the current project or \"work\" if no -project is defined." - (vhdl-resolve-env-variable - (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) - vhdl-default-library))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Enabling/disabling - -(define-minor-mode vhdl-electric-mode - "Toggle VHDL electric mode." - :global t :group 'vhdl-mode) - -(define-minor-mode vhdl-stutter-mode - "Toggle VHDL stuttering mode." - :global t :group 'vhdl-mode) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Stuttering - -(defun vhdl-electric-dash (count) - "-- starts a comment, --- draws a horizontal line, ----- starts a display comment." - (interactive "p") - (if (and vhdl-stutter-mode (not (vhdl-in-literal))) - (cond - ((and abbrev-start-location (= abbrev-start-location (point))) - (setq abbrev-start-location nil) - (goto-char last-abbrev-location) - (beginning-of-line nil) - (vhdl-comment-display)) - ((/= (preceding-char) ?-) ; standard dash (minus) - (self-insert-command count)) - (t (self-insert-command count) - (message "Enter `-' for horiz. line, RET for commenting-out code, else enter comment") - (let ((next-input (read-char))) - (if (= next-input ?-) ; triple dash - (progn - (vhdl-comment-display-line) - (message - "Enter `-' for display comment, else continue coding") - (let ((next-input (read-char))) - (if (= next-input ?-) ; four dashes - (vhdl-comment-display t) - (push (vhdl-character-to-event next-input) - ; pushback the char - unread-command-events)))) - (push (vhdl-character-to-event next-input) ; pushback the char - unread-command-events) - (vhdl-comment-insert))))) - (self-insert-command count))) - -(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) ?\() - (progn (delete-char -1) (insert-char ?\[ 1)) - (insert-char ?\( 1)) - (self-insert-command count))) - -(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (progn - (if (= (preceding-char) ?\)) - (progn (delete-char -1) (insert-char ?\] 1)) - (insert-char ?\) 1)) - (blink-matching-open)) - (self-insert-command count))) - -(defun vhdl-electric-quote (count) "\\='\\=' --> \"" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) vhdl-last-input-event) - (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) vhdl-last-input-event) - (progn (delete-char -1) - (unless (eq (preceding-char) ? ) (insert " ")) - (insert ": ") - (setq this-command 'vhdl-electric-colon))) - ((and - (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) - (progn (delete-char -1) (insert "= "))) - (t (insert-char ?\; 1))) - (self-insert-command count))) - -(defun vhdl-electric-comma (count) "`,,' --> ` <= '" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) vhdl-last-input-event) - (progn (delete-char -1) - (unless (eq (preceding-char) ? ) (insert " ")) - (insert "<= "))) - (t (insert-char ?\, 1))) - (self-insert-command count))) - -(defun vhdl-electric-period (count) "`..' --> ` => '" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - ;; We use this-command-keys below to account for translation of - ;; kp-decimal into '.'; vhdl-last-input-event doesn't catch - ;; that. - (cond ((eq (preceding-char) (aref (this-command-keys) 0)) - (progn (delete-char -1) - (unless (eq (preceding-char) ? ) (insert " ")) - (insert "=> "))) - (t (insert-char ?\. 1))) - (self-insert-command count))) - -(defun vhdl-electric-equal (count) "`==' --> ` == '" - (interactive "p") - (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) vhdl-last-input-event) - (progn (delete-char -1) - (unless (eq (preceding-char) ? ) (insert " ")) - (insert "== "))) - (t (insert-char ?\= 1))) - (self-insert-command count))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; VHDL templates - -(defun vhdl-template-paired-parens () - "Insert a pair of round parentheses, placing point between them." - (interactive) - (insert "()") - (backward-char)) - -(defun vhdl-template-alias () - "Insert alias declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "ALIAS ") - (when (vhdl-template-field "name" nil t start (point)) - (insert " : ") - (unless (vhdl-template-field - (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") - nil t) - (delete-char -3)) - (vhdl-insert-keyword " IS ") - (vhdl-template-field "name" ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-architecture () - "Insert architecture." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - arch-name) - (vhdl-insert-keyword "ARCHITECTURE ") - (when (setq arch-name - (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " OF ") - (if (save-excursion - (vhdl-prepare-search-1 - (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) - (insert (match-string 1)) - (vhdl-template-field "entity name")) - (vhdl-insert-keyword " IS\n") - (vhdl-template-begin-end - (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin - (memq vhdl-insert-empty-lines '(unit all)))))) - -(defun vhdl-template-array (kind &optional secondary) - "Insert array type definition." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "ARRAY (") - (when (or (vhdl-template-field "range" nil (not secondary) start (point)) - secondary) - (vhdl-insert-keyword ") OF ") - (vhdl-template-field (if (eq kind 'type) "type" "nature")) - (vhdl-insert-keyword ";")))) - -(defun vhdl-template-assert () - "Insert an assertion statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "ASSERT ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (when (vhdl-template-field "condition (negated)" nil t start (point)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (setq start (point)) - (vhdl-insert-keyword " REPORT ") - (unless (vhdl-template-field "string expression" nil nil nil nil t) - (delete-region start (point))) - (setq start (point)) - (vhdl-insert-keyword " SEVERITY ") - (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) - (delete-region start (point))) - (insert ";")))) - -(defun vhdl-template-attribute () - "Insert an attribute declaration or specification." - (interactive) - (if (eq (vhdl-decision-query - "attribute" "(d)eclaration or (s)pecification?" t) ?s) - (vhdl-template-attribute-spec) - (vhdl-template-attribute-decl))) - -(defun vhdl-template-attribute-decl () - "Insert an attribute declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "ATTRIBUTE ") - (when (vhdl-template-field "name" " : " t start (point)) - (vhdl-template-field "type" ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-attribute-spec () - "Insert an attribute specification." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "ATTRIBUTE ") - (when (vhdl-template-field "name" nil t start (point)) - (vhdl-insert-keyword " OF ") - (vhdl-template-field "entity names | OTHERS | ALL" " : ") - (vhdl-template-field "entity class") - (vhdl-insert-keyword " IS ") - (vhdl-template-field "expression" ";")))) - -(defun vhdl-template-block () - "Insert a block." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label) - (vhdl-insert-keyword ": BLOCK ") - (goto-char start) - (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) - (forward-word-strictly 1) - (forward-char 1) - (insert "(") - (if (vhdl-template-field "[guard expression]" nil t) - (insert ")") - (delete-char -2)) - (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) - (insert "\n") - (vhdl-template-begin-end "BLOCK" label margin) - (vhdl-comment-block)))) - -(defun vhdl-template-block-configuration () - "Insert a block configuration statement." - (interactive) - (let ((margin (current-indentation)) - (start (point))) - (vhdl-insert-keyword "FOR ") - (when (vhdl-template-field "block name" nil t start (point)) - (vhdl-insert-keyword "\n\n") - (indent-to margin) - (vhdl-insert-keyword "END FOR;") - (end-of-line 0) - (indent-to (+ margin vhdl-basic-offset))))) - -(defun vhdl-template-break () - "Insert a break statement." - (interactive) - (let (position) - (vhdl-insert-keyword "BREAK") - (setq position (point)) - (insert " ") - (while (or - (progn (vhdl-insert-keyword "FOR ") - (if (vhdl-template-field "[quantity name]" " USE " t) - (progn (vhdl-template-field "quantity name" " => ") t) - (delete-region (point) - (progn (forward-word-strictly -1) (point))) - nil)) - (vhdl-template-field "[quantity name]" " => " t)) - (vhdl-template-field "expression") - (setq position (point)) - (insert ", ")) - (delete-region position (point)) - (unless (vhdl-sequential-statement-p) - (vhdl-insert-keyword " ON ") - (if (vhdl-template-field "[sensitivity list]" nil t) - (setq position (point)) - (delete-region position (point)))) - (vhdl-insert-keyword " WHEN ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (if (vhdl-template-field "[condition]" nil t) - (when vhdl-conditions-in-parenthesis (insert ")")) - (delete-region position (point))) - (insert ";"))) - -(defun vhdl-template-case (&optional kind) - "Insert a case statement." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label) - (unless kind (setq kind (if (or (vhdl-sequential-statement-p) - (not (vhdl-standard-p 'ams))) 'is 'use))) - (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) - (vhdl-insert-keyword "CASE ") - (vhdl-insert-keyword ": CASE ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (when (vhdl-template-field "expression" nil t start (point)) - (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) - (indent-to margin) - (vhdl-insert-keyword "END CASE") - (when label (insert " " label)) - (insert ";") - (forward-line -1) - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "WHEN ") - (let ((position (point))) - (insert " => ;\n") - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "WHEN OTHERS => null;") - (goto-char position))))) - -(defun vhdl-template-case-is () - "Insert a sequential case statement." - (interactive) - (vhdl-template-case 'is)) - -(defun vhdl-template-case-use () - "Insert a simultaneous case statement." - (interactive) - (vhdl-template-case 'use)) - -(defun vhdl-template-component () - "Insert a component declaration." - (interactive) - (vhdl-template-component-decl)) - -(defun vhdl-template-component-conf () - "Insert a component configuration (uses `vhdl-template-configuration-spec' -since these are almost equivalent)." - (interactive) - (let ((margin (current-indentation)) - (result (vhdl-template-configuration-spec t))) - (when result - (insert "\n") - (indent-to margin) - (vhdl-insert-keyword "END FOR;") - (when (eq result 'no-use) - (end-of-line -0))))) - -(defun vhdl-template-component-decl () - "Insert a component declaration." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name end-column) - (vhdl-insert-keyword "COMPONENT ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) - (insert "\n\n") - (indent-to margin) - (vhdl-insert-keyword "END COMPONENT") - (unless (vhdl-standard-p '87) (insert " " name)) - (insert ";") - (setq end-column (current-column)) - (end-of-line -0) - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-template-generic-list t t) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-template-port-list t) - (beginning-of-line 2) - (forward-char end-column)))) - -(defun vhdl-template-component-inst () - "Insert a component instantiation statement." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - unit position) - (when (vhdl-template-field "instance label" nil t start (point)) - (insert ": ") - (if (not (vhdl-use-direct-instantiation)) - (vhdl-template-field "component name") - ;; direct instantiation - (setq unit (vhdl-template-field - "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) - (setq unit (upcase (or unit ""))) - (cond ((equal unit "ENTITY") - (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)))) - ((equal unit "CONFIGURATION") - (vhdl-template-field "library name" "." nil nil nil nil - (vhdl-work-library)) - (vhdl-template-field "configuration name")) - (t (vhdl-template-field "component name")))) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (vhdl-insert-keyword "GENERIC ") - (when (vhdl-template-map position t t) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset))) - (setq position (point)) - (vhdl-insert-keyword "PORT ") - (unless (vhdl-template-map position t t) - (delete-region (line-beginning-position) (point)) - (delete-char -1)) - (insert ";")))) - -(defun vhdl-template-conditional-signal-asst () - "Insert a conditional signal assignment." - (interactive) - (when (vhdl-template-field "target signal") - (insert " <= ") - (let ((margin (current-column)) - (start (point)) - position) - (vhdl-template-field "waveform") - (setq position (point)) - (vhdl-insert-keyword " WHEN ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (while (and (vhdl-template-field "[condition]" nil t) - (progn - (when vhdl-conditions-in-parenthesis (insert ")")) - (setq position (point)) - (vhdl-insert-keyword " ELSE") - (insert "\n") - (indent-to margin) - (vhdl-template-field "[waveform]" nil t))) - (setq position (point)) - (vhdl-insert-keyword " WHEN ") - (when vhdl-conditions-in-parenthesis (insert "("))) - (delete-region position (point)) - (insert ";") - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) - -(defun vhdl-template-configuration () - "Insert a configuration specification if within an architecture, -a block or component configuration if within a configuration declaration, -a configuration declaration if not within a design unit." - (interactive) - (vhdl-prepare-search-1 - (cond - ((and (save-excursion ; architecture body - (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) - (equal "ARCHITECTURE" (upcase (match-string 1)))) - (vhdl-template-configuration-spec)) - ((and (save-excursion ; configuration declaration - (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) - (equal "CONFIGURATION" (upcase (match-string 1)))) - (if (eq (vhdl-decision-query - "configuration" "(b)lock or (c)omponent configuration?" t) - ?c) - (vhdl-template-component-conf) - (vhdl-template-block-configuration))) - (t (vhdl-template-configuration-decl))))) ; otherwise - -(defun vhdl-template-configuration-spec (&optional optional-use) - "Insert a configuration specification." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - aspect position) - (vhdl-insert-keyword "FOR ") - (when (vhdl-template-field "instance names | OTHERS | ALL" " : " - t start (point)) - (vhdl-template-field "component name" "\n") - (indent-to (+ margin vhdl-basic-offset)) - (setq start (point)) - (vhdl-insert-keyword "USE ") - (if (and optional-use - (not (setq aspect (vhdl-template-field - "[ENTITY | CONFIGURATION | OPEN]" " " t)))) - (progn (delete-region start (point)) 'no-use) - (unless optional-use - (setq aspect (vhdl-template-field - "ENTITY | CONFIGURATION | OPEN" " "))) - (setq aspect (upcase (or aspect ""))) - (cond ((equal aspect "ENTITY") - (vhdl-template-field "library name" "." nil nil nil nil - (vhdl-work-library)) - (vhdl-template-field "entity name" "(") - (if (vhdl-template-field "[architecture name]" nil t) - (insert ")") - (delete-char -1)) - (insert "\n") - (indent-to (+ margin (* 2 vhdl-basic-offset))) - (setq position (point)) - (vhdl-insert-keyword "GENERIC ") - (when (vhdl-template-map position t t) - (insert "\n") - (indent-to (+ margin (* 2 vhdl-basic-offset)))) - (setq position (point)) - (vhdl-insert-keyword "PORT ") - (unless (vhdl-template-map position t t) - (delete-region (line-beginning-position) (point)) - (delete-char -1)) - (insert ";") - t) - ((equal aspect "CONFIGURATION") - (vhdl-template-field "library name" "." nil nil nil nil - (vhdl-work-library)) - (vhdl-template-field "configuration name" ";")) - (t (delete-char -1) (insert ";") t)))))) - - -(defun vhdl-template-configuration-decl () - "Insert a configuration declaration." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - entity-exists string name position) - (vhdl-insert-keyword "CONFIGURATION ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " OF ") - (save-excursion - (vhdl-prepare-search-1 - (setq entity-exists (vhdl-re-search-backward - "\\<entity \\(\\w*\\) is\\>" nil t)) - (setq string (match-string 1)))) - (if (and entity-exists (not (equal string ""))) - (insert string) - (vhdl-template-field "entity name")) - (vhdl-insert-keyword " IS\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (insert "\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) - (vhdl-insert-keyword "CONFIGURATION ")) - (insert name ";") - (goto-char position)))) - -(defun vhdl-template-constant () - "Insert a constant declaration." - (interactive) - (let ((start (point)) - (in-arglist (vhdl-in-argument-list-p))) - (vhdl-insert-keyword "CONSTANT ") - (when (vhdl-template-field "name" nil t start (point)) - (insert " : ") - (when in-arglist (vhdl-insert-keyword "IN ")) - (vhdl-template-field "type") - (if in-arglist - (progn (insert ";") - (vhdl-comment-insert-inline)) - (let ((position (point))) - (insert " := ") - (unless (vhdl-template-field "[initialization]" nil t) - (delete-region position (point))) - (insert ";") - (vhdl-comment-insert-inline)))))) - -(defun vhdl-template-context () - "Insert a context declaration." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name position) ;; entity-exists string - (vhdl-insert-keyword "CONTEXT ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " IS\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (insert "\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) - (vhdl-insert-keyword "CONTEXT ")) - (insert name ";") - (goto-char position)))) - -(defun vhdl-template-default () - "Insert nothing." - (interactive) - (insert " ") - (unexpand-abbrev) - (backward-word-strictly 1) - (vhdl-case-word 1) - (forward-char 1)) - -(defun vhdl-template-default-indent () - "Insert nothing and indent." - (interactive) - (insert " ") - (unexpand-abbrev) - (backward-word-strictly 1) - (vhdl-case-word 1) - (forward-char 1) - (indent-according-to-mode)) - -(defun vhdl-template-disconnect () - "Insert a disconnect statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "DISCONNECT ") - (when (vhdl-template-field "signal names | OTHERS | ALL" - " : " t start (point)) - (vhdl-template-field "type") - (vhdl-insert-keyword " AFTER ") - (vhdl-template-field "time expression" ";")))) - -(defun vhdl-template-else () - "Insert an else statement." - (interactive) - (let (margin) - (vhdl-prepare-search-1 - (vhdl-insert-keyword "ELSE") - (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t)) - (match-string 2)) - (insert " ") - (unless (vhdl-sequential-statement-p) - (vhdl-insert-keyword " GENERATE")) - (indent-according-to-mode) - (setq margin (current-indentation)) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)))))) - -(defun vhdl-template-elsif () - "Insert an elsif statement." - (interactive) - (let ((start (point)) - margin) - (vhdl-insert-keyword "ELSIF ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (when (vhdl-template-field "condition" nil t start (point)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (indent-according-to-mode) - (setq margin (current-indentation)) - (vhdl-insert-keyword - (concat " " (cond ((vhdl-sequential-statement-p) "THEN") - ((vhdl-standard-p 'ams) "USE") - (t "GENERATE")) "\n")) - (indent-to (+ margin vhdl-basic-offset))))) - -(defun vhdl-template-entity () - "Insert an entity." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name end-column) - (vhdl-insert-keyword "ENTITY ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " IS\n\n") - (indent-to margin) - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) - (insert name ";") - (setq end-column (current-column)) - (end-of-line -0) - (indent-to (+ margin vhdl-basic-offset)) - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (when (vhdl-template-generic-list t) - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (when (vhdl-template-port-list t) - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) - (beginning-of-line 2) - (forward-char end-column)))) - -(defun vhdl-template-exit () - "Insert an exit statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "EXIT ") - (if (vhdl-template-field "[loop label]" nil t start (point)) - (let ((position (point))) - (vhdl-insert-keyword " WHEN ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (if (vhdl-template-field "[condition]" nil t) - (when vhdl-conditions-in-parenthesis (insert ")")) - (delete-region position (point)))) - (delete-char -1)) - (insert ";"))) - -(defun vhdl-template-file () - "Insert a file declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "FILE ") - (when (vhdl-template-field "name" nil t start (point)) - (insert " : ") - (vhdl-template-field "type") - (unless (vhdl-standard-p '87) - (vhdl-insert-keyword " OPEN ") - (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" - nil t) - (delete-char -6))) - (vhdl-insert-keyword " IS ") - (when (vhdl-standard-p '87) - (vhdl-template-field "[IN | OUT]" " " t)) - (vhdl-template-field "filename-string" nil nil nil nil t) - (insert ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-for () - "Insert a block or component configuration if within a configuration -declaration, a configuration specification if within an architecture -declarative part (and not within a subprogram), a for-loop if within a -sequential statement part (subprogram or process), and a for-generate -otherwise." - (interactive) - (vhdl-prepare-search-1 - (cond - ((vhdl-sequential-statement-p) ; sequential statement - (vhdl-template-for-loop)) - ((and (save-excursion ; configuration declaration - (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) - (equal "CONFIGURATION" (upcase (match-string 1)))) - (if (eq (vhdl-decision-query - "for" "(b)lock or (c)omponent configuration?" t) - ?c) - (vhdl-template-component-conf) - (vhdl-template-block-configuration))) - ((and (save-excursion - (re-search-backward ; architecture declarative part - "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) - (equal "ARCHITECTURE" (upcase (match-string 1)))) - (vhdl-template-configuration-spec)) - (t (vhdl-template-for-generate))))) ; concurrent statement - -(defun vhdl-template-for-generate () - "Insert a for-generate." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label position) - (vhdl-insert-keyword ": FOR ") - (setq position (point-marker)) - (goto-char start) - (when (setq label (vhdl-template-field "label" nil t start position)) - (goto-char position) - (vhdl-template-field "loop variable") - (vhdl-insert-keyword " IN ") - (vhdl-template-field "range") - (vhdl-template-generate-body margin label)))) - -(defun vhdl-template-for-loop () - "Insert a for loop." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label index) - (if (not (eq vhdl-optional-labels 'all)) - (vhdl-insert-keyword "FOR ") - (vhdl-insert-keyword ": FOR ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (when (setq index (vhdl-template-field "loop variable" - nil t start (point))) - (vhdl-insert-keyword " IN ") - (vhdl-template-field "range") - (vhdl-insert-keyword " LOOP\n\n") - (indent-to margin) - (vhdl-insert-keyword "END LOOP") - (if label - (insert " " label ";") - (insert ";") - (when vhdl-self-insert-comments (insert " -- " index))) - (forward-line -1) - (indent-to (+ margin vhdl-basic-offset))))) - -(defun vhdl-template-function (&optional kind) - "Insert a function declaration or body." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name) - (vhdl-insert-keyword "FUNCTION ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-template-argument-list t) - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) - (end-of-line) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "RETURN ") - (vhdl-template-field "type") - (if (if kind (eq kind 'body) - (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) - (progn (vhdl-insert-keyword " IS\n") - (vhdl-template-begin-end - (unless (vhdl-standard-p '87) "FUNCTION") name margin) - (vhdl-comment-block)) - (insert ";"))))) - -(defun vhdl-template-function-decl () - "Insert a function declaration." - (interactive) - (vhdl-template-function 'decl)) - -(defun vhdl-template-function-body () - "Insert a function declaration." - (interactive) - (vhdl-template-function 'body)) - -(defun vhdl-template-generate () - "Insert a generation scheme." - (interactive) - (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) - (vhdl-template-if-generate) - (vhdl-template-for-generate))) - -(defun vhdl-template-generic () - "Insert generic declaration, or generic map in instantiation statements." - (interactive) - (let ((start (point))) - (vhdl-prepare-search-1 - (cond - ((and (save-excursion ; entity declaration - (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) - (equal "ENTITY" (upcase (match-string 1)))) - (vhdl-template-generic-list nil)) - ((or (save-excursion - (or (beginning-of-line) - (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) - (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) - (vhdl-insert-keyword "GENERIC ") - (vhdl-template-map start)) - (t (vhdl-template-generic-list nil t)))))) - -(defun vhdl-template-group () - "Insert group or group template declaration." - (interactive) - ;; (let ((start (point))) - (if (eq (vhdl-decision-query - "group" "(d)eclaration or (t)emplate declaration?" t) - ?t) - (vhdl-template-group-template) - (vhdl-template-group-decl))) ;; ) - -(defun vhdl-template-group-decl () - "Insert group declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "GROUP ") - (when (vhdl-template-field "name" " : " t start (point)) - (vhdl-template-field "template name" " (") - (vhdl-template-field "constituent list" ");") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-group-template () - "Insert group template declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "GROUP ") - (when (vhdl-template-field "template name" nil t start (point)) - (vhdl-insert-keyword " IS (") - (vhdl-template-field "entity class list" ");") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-if () - "Insert a sequential if statement or an if-generate statement." - (interactive) - (if (vhdl-sequential-statement-p) - (vhdl-template-if-then) - (if (and (vhdl-standard-p 'ams) - (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) - (vhdl-template-if-use) - (vhdl-template-if-generate)))) - -(defun vhdl-template-if-generate () - "Insert an if-generate." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label position) - (vhdl-insert-keyword ": IF ") - (setq position (point-marker)) - (goto-char start) - (when (setq label (vhdl-template-field "label" nil t start position)) - (goto-char position) - (when vhdl-conditions-in-parenthesis (insert "(")) - (vhdl-template-field "condition") - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-template-generate-body margin label)))) - -(defun vhdl-template-if-then-use (kind) - "Insert a sequential if statement." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label) - (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) - (vhdl-insert-keyword "IF ") - (vhdl-insert-keyword ": IF ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (when vhdl-conditions-in-parenthesis (insert "(")) - (when (vhdl-template-field "condition" nil t start (point)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-insert-keyword - (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) - (indent-to margin) - (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE"))) - (when label (insert " " label)) - (insert ";") - (forward-line -1) - (indent-to (+ margin vhdl-basic-offset))))) - -(defun vhdl-template-if-then () - "Insert a sequential if statement." - (interactive) - (vhdl-template-if-then-use 'then)) - -(defun vhdl-template-if-use () - "Insert a simultaneous if statement." - (interactive) - (vhdl-template-if-then-use 'use)) - -(defun vhdl-template-instance () - "Insert a component instantiation statement." - (interactive) - (vhdl-template-component-inst)) - -(defun vhdl-template-library () - "Insert a library specification." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name end-pos) - (vhdl-insert-keyword "LIBRARY ") - (when (setq name (vhdl-template-field "names" nil t start (point))) - (insert ";") - (unless (string-match "," name) - (setq end-pos (point)) - (insert "\n") - (indent-to margin) - (vhdl-insert-keyword "USE ") - (insert name) - (vhdl-insert-keyword "..ALL;") - (backward-char 5) - (if (vhdl-template-field "package name") - (forward-char 5) - (delete-region end-pos (+ (point) 5))))))) - -(defun vhdl-template-limit () - "Insert a limit." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "LIMIT ") - (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " - t start (point)) - (vhdl-template-field "type") - (vhdl-insert-keyword " WITH ") - (vhdl-template-field "real expression" ";")))) - -(defun vhdl-template-loop () - "Insert a loop." - (interactive) - (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) - (cond ((eq char ?w) - (vhdl-template-while-loop)) - ((eq char ?f) - (vhdl-template-for-loop)) - (t (vhdl-template-bare-loop))))) - -(defun vhdl-template-bare-loop () - "Insert a loop." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - label) - (if (not (eq vhdl-optional-labels 'all)) - (vhdl-insert-keyword "LOOP ") - (vhdl-insert-keyword ": LOOP ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (delete-char 1)) - (insert "\n\n") - (indent-to margin) - (vhdl-insert-keyword "END LOOP") - (insert (if label (concat " " label ";") ";")) - (forward-line -1) - (indent-to (+ margin vhdl-basic-offset)))) - -(defun vhdl-template-map (&optional start optional secondary) - "Insert a map specification with association list." - (interactive) - (let ((start (or start (point))) - margin end-pos) - (vhdl-insert-keyword "MAP (") - (if (not vhdl-association-list-with-formals) - (if (vhdl-template-field - (concat (and optional "[") "association list" (and optional "]")) - ")" (or (not secondary) optional) - (and (not secondary) start) (point)) - t - (if (and optional secondary) (delete-region start (point))) - nil) - (if vhdl-argument-list-indent - (setq margin (current-column)) - (setq margin (+ (current-indentation) vhdl-basic-offset)) - (insert "\n") - (indent-to margin)) - (if (vhdl-template-field - (concat (and optional "[") "formal" (and optional "]")) - " => " (or (not secondary) optional) - (and (not secondary) start) (point)) - (progn - (vhdl-template-field "actual" ",") - (setq end-pos (point)) - (insert "\n") - (indent-to margin) - (while (vhdl-template-field "[formal]" " => " t) - (vhdl-template-field "actual" ",") - (setq end-pos (point)) - (insert "\n") - (indent-to margin)) - (delete-region end-pos (point)) - (delete-char -1) - (insert ")") - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) - t) - (when (and optional secondary) (delete-region start (point))) - nil)))) - -(defun vhdl-template-modify (&optional noerror) - "Actualize modification date." - (interactive) - (vhdl-prepare-search-2 - (save-excursion - (goto-char (point-min)) - (if (re-search-forward vhdl-modify-date-prefix-string nil t) - (progn (delete-region (point) (progn (end-of-line) (point))) - (vhdl-template-insert-date)) - (unless noerror - (error "ERROR: Modification date prefix string \"%s\" not found" - vhdl-modify-date-prefix-string)))))) - - -(defun vhdl-template-modify-noerror () - "Call `vhdl-template-modify' with NOERROR non-nil." - (vhdl-template-modify t)) - -(defun vhdl-template-nature () - "Insert a nature declaration." - (interactive) - (let ((start (point)) - name mid-pos end-pos) - (vhdl-insert-keyword "NATURE ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " IS ") - (let ((definition - (upcase - (or (vhdl-template-field - "across type | ARRAY | RECORD") - "")))) - (cond ((equal definition "") - (insert ";")) - ((equal definition "ARRAY") - (delete-region (point) (progn (forward-word-strictly -1) - (point))) - (vhdl-template-array 'nature t)) - ((equal definition "RECORD") - (setq mid-pos (point-marker)) - (delete-region (point) (progn (forward-word-strictly -1) - (point))) - (vhdl-template-record 'nature name t)) - (t - (vhdl-insert-keyword " ACROSS ") - (vhdl-template-field "through type") - (vhdl-insert-keyword " THROUGH ") - (vhdl-template-field "reference name") - (vhdl-insert-keyword " REFERENCE;"))) - (when mid-pos - (setq end-pos (point-marker)) - (goto-char mid-pos) - (end-of-line)) - (vhdl-comment-insert-inline) - (when end-pos (goto-char end-pos)))))) - -(defun vhdl-template-next () - "Insert a next statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "NEXT ") - (if (vhdl-template-field "[loop label]" nil t start (point)) - (let ((position (point))) - (vhdl-insert-keyword " WHEN ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (if (vhdl-template-field "[condition]" nil t) - (when vhdl-conditions-in-parenthesis (insert ")")) - (delete-region position (point)))) - (delete-char -1)) - (insert ";"))) - -(defun vhdl-template-others () - "Insert an others aggregate." - (interactive) - (let ((start (point))) - (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) - (progn (unless vhdl-template-invoked-by-hook (insert "(")) - (vhdl-insert-keyword "OTHERS => '") - (when (vhdl-template-field "value" nil t start (point)) - (insert "')"))) - (vhdl-insert-keyword "OTHERS ")))) - -(defun vhdl-template-package (&optional kind) - "Insert a package specification or body." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name body position) - (vhdl-insert-keyword "PACKAGE ") - (setq body (if kind (eq kind 'body) - (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) - (when body - (vhdl-insert-keyword "BODY ") - (when (save-excursion - (vhdl-prepare-search-1 - (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) - (insert (setq name (match-string 1))))) - (when (or name - (setq name (vhdl-template-field "name" nil t start (point)))) - (vhdl-insert-keyword " IS\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (insert "\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) - (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) - (insert (or name "") ";") - (goto-char position)))) - -(defun vhdl-template-package-decl () - "Insert a package specification." - (interactive) - (vhdl-template-package 'decl)) - -(defun vhdl-template-package-body () - "Insert a package body." - (interactive) - (vhdl-template-package 'body)) - -(defun vhdl-template-port () - "Insert a port declaration, or port map in instantiation statements." - (interactive) - (let ((start (point))) - (vhdl-prepare-search-1 - (cond - ((and (save-excursion ; entity declaration - (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) - (equal "ENTITY" (upcase (match-string 1)))) - (vhdl-template-port-list nil)) - ((or (save-excursion - (or (beginning-of-line) - (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) - (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) - (vhdl-insert-keyword "PORT ") - (vhdl-template-map start)) - (t (vhdl-template-port-list nil)))))) - -(defun vhdl-template-procedural () - "Insert a procedural." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - (case-fold-search t) - label) - (vhdl-insert-keyword "PROCEDURAL ") - (when (memq vhdl-optional-labels '(process all)) - (goto-char start) - (insert ": ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) - (insert "\n") - (vhdl-template-begin-end "PROCEDURAL" label margin) - (vhdl-comment-block))) - -(defun vhdl-template-procedure (&optional kind) - "Insert a procedure declaration or body." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - name) - (vhdl-insert-keyword "PROCEDURE ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-template-argument-list) - (if (if kind (eq kind 'body) - (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) - (progn (vhdl-insert-keyword " IS") - (when vhdl-auto-align - (vhdl-align-region-groups start (point) 1)) - (end-of-line) (insert "\n") - (vhdl-template-begin-end - (unless (vhdl-standard-p '87) "PROCEDURE") - name margin) - (vhdl-comment-block)) - (insert ";") - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) - (end-of-line))))) - -(defun vhdl-template-procedure-decl () - "Insert a procedure declaration." - (interactive) - (vhdl-template-procedure 'decl)) - -(defun vhdl-template-procedure-body () - "Insert a procedure body." - (interactive) - (vhdl-template-procedure 'body)) - -(defun vhdl-template-process (&optional kind) - "Insert a process." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - (reset-kind vhdl-reset-kind) - label seq input-signals clock reset final-pos) - (setq seq (if kind (eq kind 'seq) - (eq (vhdl-decision-query - "process" "(c)ombinational or (s)equential?" t) ?s))) - (vhdl-insert-keyword "PROCESS ") - (when (memq vhdl-optional-labels '(process all)) - (goto-char start) - (insert ": ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (insert "(") - (if (not seq) - (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all - (progn (insert "all)") (setq input-signals "all"))) - (setq input-signals - (vhdl-template-field "[sensitivity list]" ")" t))) - (setq input-signals "") - (delete-char -2)) - (setq clock (or (and (not (equal "" vhdl-clock-name)) - (progn (insert vhdl-clock-name) vhdl-clock-name)) - (vhdl-template-field "clock name") "<clock>")) - (when (eq reset-kind 'query) - (setq reset-kind - (if (eq (vhdl-decision-query - "" "(a)synchronous or (s)ynchronous reset?" t) ?a) - 'async - 'sync))) - (when (eq reset-kind 'async) - (insert ", ") - (setq reset (or (and (not (equal "" vhdl-reset-name)) - (progn (insert vhdl-reset-name) vhdl-reset-name)) - (vhdl-template-field "reset name") "<reset>"))) - (insert ")")) - (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) - (insert "\n") - (vhdl-template-begin-end "PROCESS" label margin) - (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind))) - (when vhdl-prompt-for-comments - (setq final-pos (point-marker)) - (vhdl-prepare-search-2 - (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) - (vhdl-re-search-backward "\\<process\\>" nil t)) - (end-of-line -0) - (if (bobp) - (progn (insert "\n") (forward-line -1)) - (insert "\n")) - (indent-to margin) - (insert "-- purpose: ") - (if (not (vhdl-template-field "[description]" nil t)) - (vhdl-line-kill-entire) - (insert "\n") - (indent-to margin) - (insert "-- type : ") - (insert (if seq "sequential" "combinational") "\n") - (indent-to margin) - (insert "-- inputs : ") - (if (not seq) - (insert input-signals) - (insert clock ", ") - (when reset (insert reset ", ")) - (unless (vhdl-template-field "[signal names]" nil t) - (delete-char -2))) - (insert "\n") - (indent-to margin) - (insert "-- outputs: ") - (vhdl-template-field "[signal names]" nil t)))) - (goto-char final-pos)))) - -(defun vhdl-template-process-comb () - "Insert a combinational process." - (interactive) - (vhdl-template-process 'comb)) - -(defun vhdl-template-process-seq () - "Insert a sequential process." - (interactive) - (vhdl-template-process 'seq)) - -(defun vhdl-template-quantity () - "Insert a quantity declaration." - (interactive) - (if (vhdl-in-argument-list-p) - (let ((start (point))) - (vhdl-insert-keyword "QUANTITY ") - (when (vhdl-template-field "names" nil t start (point)) - (insert " : ") - (vhdl-template-field "[IN | OUT]" " " t) - (vhdl-template-field "type") - (insert ";") - (vhdl-comment-insert-inline))) - (let ((char (vhdl-decision-query - "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) - (cond ((eq char ?f) (vhdl-template-quantity-free)) - ((eq char ?b) (vhdl-template-quantity-branch)) - ((eq char ?s) (vhdl-template-quantity-source)) - (t (vhdl-template-undo (point) (point))))))) - -(defun vhdl-template-quantity-free () - "Insert a free quantity declaration." - (interactive) - (vhdl-insert-keyword "QUANTITY ") - (vhdl-template-field "names") - (insert " : ") - (vhdl-template-field "type") - (let ((position (point))) - (insert " := ") - (unless (vhdl-template-field "[initialization]" nil t) - (delete-region position (point))) - (insert ";") - (vhdl-comment-insert-inline))) - -(defun vhdl-template-quantity-branch () - "Insert a branch quantity declaration." - (interactive) - (let (position) - (vhdl-insert-keyword "QUANTITY ") - (when (vhdl-template-field "[across names]" " " t) - (vhdl-insert-keyword "ACROSS ")) - (when (vhdl-template-field "[through names]" " " t) - (vhdl-insert-keyword "THROUGH ")) - (vhdl-template-field "plus terminal name") - (setq position (point)) - (vhdl-insert-keyword " TO ") - (unless (vhdl-template-field "[minus terminal name]" nil t) - (delete-region position (point))) - (insert ";") - (vhdl-comment-insert-inline))) - -(defun vhdl-template-quantity-source () - "Insert a source quantity declaration." - (interactive) - (vhdl-insert-keyword "QUANTITY ") - (vhdl-template-field "names") - (insert " : ") - (vhdl-template-field "type" " ") - (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) - (progn (vhdl-insert-keyword "NOISE ") - (vhdl-template-field "power expression")) - (vhdl-insert-keyword "SPECTRUM ") - (vhdl-template-field "magnitude expression" ", ") - (vhdl-template-field "phase expression")) - (insert ";") - (vhdl-comment-insert-inline)) - -(defun vhdl-template-record (kind &optional name secondary) - "Insert a record type declaration." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - (first t)) - (vhdl-insert-keyword "RECORD\n") - (indent-to (+ margin vhdl-basic-offset)) - (when (or (vhdl-template-field "element names" - nil (not secondary) start (point)) - secondary) - (while (or first (vhdl-template-field "[element names]" nil t)) - (insert " : ") - (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") - (vhdl-comment-insert-inline) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (setq first nil)) - (delete-region (line-beginning-position) (point)) - (indent-to margin) - (vhdl-insert-keyword "END RECORD") - (unless (vhdl-standard-p '87) (and name (insert " " name))) - (insert ";") - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) - -(defun vhdl-template-report () - "Insert a report statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "REPORT ") - (if (equal "\"\"" (vhdl-template-field - "string expression" nil t start (point) t)) - (delete-char -2) - (setq start (point)) - (vhdl-insert-keyword " SEVERITY ") - (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) - (delete-region start (point))) - (insert ";")))) - -(defun vhdl-template-return () - "Insert a return statement." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "RETURN ") - (unless (vhdl-template-field "[expression]" nil t start (point)) - (delete-char -1)) - (insert ";"))) - -(defun vhdl-template-selected-signal-asst () - "Insert a selected signal assignment." - (interactive) - (let ((margin (current-indentation)) - (start (point)) - (choices t)) - (let ((position (point))) - (vhdl-insert-keyword " SELECT ") - (goto-char position)) - (vhdl-insert-keyword "WITH ") - (when (vhdl-template-field "selector expression" - nil t start (+ (point) 7)) - (forward-word-strictly 1) - (delete-char 1) - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-template-field "target signal" " <= ") - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-template-field "waveform") - (vhdl-insert-keyword " WHEN ") - (vhdl-template-field "choices" ",") - (insert "\n") - (indent-to (+ margin vhdl-basic-offset)) - (while (and choices (vhdl-template-field "[waveform]" nil t)) - (vhdl-insert-keyword " WHEN ") - (if (setq choices (vhdl-template-field "[choices]" "," t)) - (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (vhdl-insert-keyword "OTHERS"))) - (when choices - (fixup-whitespace) - (delete-char -2)) - (insert ";") - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) - -(defun vhdl-template-signal () - "Insert a signal declaration." - (interactive) - (let ((start (point)) - (in-arglist (vhdl-in-argument-list-p))) - (vhdl-insert-keyword "SIGNAL ") - (when (vhdl-template-field "names" nil t start (point)) - (insert " : ") - (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) - (vhdl-template-field "type") - (if in-arglist - (progn (insert ";") - (vhdl-comment-insert-inline)) - (let ((position (point))) - (insert " := ") - (unless (vhdl-template-field "[initialization]" nil t) - (delete-region position (point))) - (insert ";") - (vhdl-comment-insert-inline)))))) - -(defun vhdl-template-subnature () - "Insert a subnature declaration." - (interactive) - (let ((start (point)) - position) - (vhdl-insert-keyword "SUBNATURE ") - (when (vhdl-template-field "name" nil t start (point)) - (vhdl-insert-keyword " IS ") - (vhdl-template-field "nature" " (") - (if (vhdl-template-field "[index range]" nil t) - (insert ")") - (delete-char -2)) - (setq position (point)) - (vhdl-insert-keyword " TOLERANCE ") - (if (equal "\"\"" (vhdl-template-field "[string expression]" - nil t nil nil t)) - (delete-region position (point)) - (vhdl-insert-keyword " ACROSS ") - (vhdl-template-field "string expression" nil nil nil nil t) - (vhdl-insert-keyword " THROUGH")) - (insert ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-subprogram-body () - "Insert a subprogram body." - (interactive) - (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) - (vhdl-template-function-body) - (vhdl-template-procedure-body))) - -(defun vhdl-template-subprogram-decl () - "Insert a subprogram declaration." - (interactive) - (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) - (vhdl-template-function-decl) - (vhdl-template-procedure-decl))) - -(defun vhdl-template-subtype () - "Insert a subtype declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "SUBTYPE ") - (when (vhdl-template-field "name" nil t start (point)) - (vhdl-insert-keyword " IS ") - (vhdl-template-field "type" " ") - (unless - (vhdl-template-field "[RANGE value range | ( index range )]" nil t) - (delete-char -1)) - (insert ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-terminal () - "Insert a terminal declaration." - (interactive) - (let ((start (point))) - (vhdl-insert-keyword "TERMINAL ") - (when (vhdl-template-field "names" nil t start (point)) - (insert " : ") - (vhdl-template-field "nature") - (insert ";") - (vhdl-comment-insert-inline)))) - -(defun vhdl-template-type () - "Insert a type declaration." - (interactive) - (let ((start (point)) - name mid-pos end-pos) - (vhdl-insert-keyword "TYPE ") - (when (setq name (vhdl-template-field "name" nil t start (point))) - (vhdl-insert-keyword " IS ") - (let ((definition - (upcase - (or (vhdl-template-field - "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) - "")))) - (cond ((equal definition "") - (delete-char -4) - (insert ";")) - ((equal definition "ARRAY") - (delete-region (point) (progn (forward-word-strictly -1) - (point))) - (vhdl-template-array 'type t)) - ((equal definition "RECORD") - (setq mid-pos (point-marker)) - (delete-region (point) (progn (forward-word-strictly -1) - (point))) - (vhdl-template-record 'type name t)) - ((equal definition "ACCESS") - (insert " ") - (vhdl-template-field "type" ";")) - ((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)) - (goto-char mid-pos) - (end-of-line)) - (vhdl-comment-insert-inline) - (when end-pos (goto-char end-pos)))))) - -(defun vhdl-template-use () - "Insert a use clause." - (interactive) - (let ((start (point))) - (vhdl-prepare-search-1 - (vhdl-insert-keyword "USE ") - (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) - (vhdl-insert-keyword "..ALL;") - (backward-char 6) - (when (vhdl-template-field "library name" nil t start (+ (point) 6)) - (forward-char 1) - (vhdl-template-field "package name") - (forward-char 5)))))) - -(defun vhdl-template-variable () - "Insert a variable declaration." - (interactive) - (let ((start (point)) - (in-arglist (vhdl-in-argument-list-p))) - (vhdl-prepare-search-2 - (if (or (save-excursion - (progn (vhdl-beginning-of-block) - (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>"))) - (save-excursion (backward-word-strictly 1) - (looking-at "\\<shared\\>"))) - (vhdl-insert-keyword "VARIABLE ") - (if (vhdl-standard-p '87) - (error "ERROR: Not within sequential block") - (vhdl-insert-keyword "SHARED VARIABLE ")))) - (when (vhdl-template-field "names" nil t start (point)) - (insert " : ") - (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) - (vhdl-template-field "type") - (if in-arglist - (progn (insert ";") - (vhdl-comment-insert-inline)) - (let ((position (point))) - (insert " := ") - (unless (vhdl-template-field "[initialization]" nil t) - (delete-region position (point))) - (insert ";") - (vhdl-comment-insert-inline)))))) - -(defun vhdl-template-wait () - "Insert a wait statement." - (interactive) - (vhdl-insert-keyword "WAIT ") - (unless (vhdl-template-field - "[ON sensitivity list] [UNTIL condition] [FOR time expression]" - nil t) - (delete-char -1)) - (insert ";")) - -(defun vhdl-template-when () - "Indent correctly if within a case statement." - (interactive) - (let ((position (point)) - margin) - (vhdl-prepare-search-2 - (if (and (= (current-column) (current-indentation)) - (vhdl-re-search-forward "\\<end\\>" nil t) - (looking-at "\\s-*\\<case\\>")) - (progn - (setq margin (current-indentation)) - (goto-char position) - (delete-horizontal-space) - (indent-to (+ margin vhdl-basic-offset))) - (goto-char position))) - (vhdl-insert-keyword "WHEN "))) - -(defun vhdl-template-while-loop () - "Insert a while loop." - (interactive) - (let* ((margin (current-indentation)) - (start (point)) - label) - (if (not (eq vhdl-optional-labels 'all)) - (vhdl-insert-keyword "WHILE ") - (vhdl-insert-keyword ": WHILE ") - (goto-char start) - (setq label (vhdl-template-field "[label]" nil t)) - (unless label (delete-char 2)) - (forward-word-strictly 1) - (forward-char 1)) - (when vhdl-conditions-in-parenthesis (insert "(")) - (when (vhdl-template-field "condition" nil t start (point)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-insert-keyword " LOOP\n\n") - (indent-to margin) - (vhdl-insert-keyword "END LOOP") - (insert (if label (concat " " label ";") ";")) - (forward-line -1) - (indent-to (+ margin vhdl-basic-offset))))) - -(defun vhdl-template-with () - "Insert a with statement (i.e. selected signal assignment)." - (interactive) - (vhdl-prepare-search-1 - (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) - (equal ";" (match-string 1))) - (vhdl-template-selected-signal-asst) - (vhdl-insert-keyword "WITH ")))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Special templates - -(defun vhdl-template-clocked-wait () - "Insert a wait statement for rising/falling clock edge." - (interactive) - (let ((start (point)) - clock) - (vhdl-insert-keyword "WAIT UNTIL ") - (when (setq clock - (or (and (not (equal "" vhdl-clock-name)) - (progn (insert vhdl-clock-name) vhdl-clock-name)) - (vhdl-template-field "clock name" nil t start (point)))) - (insert "'event") - (vhdl-insert-keyword " AND ") - (insert clock) - (insert - " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") - (vhdl-comment-insert-inline - (concat (if vhdl-clock-rising-edge "rising" "falling") - " clock edge"))))) - -(defun vhdl-template-seq-process (clock reset reset-kind) - "Insert a template for the body of a sequential process." - (let ((margin (current-indentation)) - position) - (vhdl-insert-keyword "IF ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (when (eq reset-kind 'async) - (insert reset " = " - (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-insert-keyword " THEN") - (vhdl-comment-insert-inline - (concat "asynchronous reset (active " - (if vhdl-reset-active-high "high" "low") ")")) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (insert "\n") (indent-to margin) - (vhdl-insert-keyword "ELSIF ") - (when vhdl-conditions-in-parenthesis (insert "("))) - (if (eq vhdl-clock-edge-condition 'function) - (insert (if vhdl-clock-rising-edge "rising" "falling") - "_edge(" clock ")") - (insert clock "'event") - (vhdl-insert-keyword " AND ") - (insert clock " = " - (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-insert-keyword " THEN") - (vhdl-comment-insert-inline - (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (when (eq reset-kind 'sync) - (vhdl-insert-keyword "IF ") - (when vhdl-conditions-in-parenthesis (insert "(")) - (setq reset (or (and (not (equal "" vhdl-reset-name)) - (progn (insert vhdl-reset-name) vhdl-reset-name)) - (vhdl-template-field "reset name") "<reset>")) - (insert " = " - (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) - (when vhdl-conditions-in-parenthesis (insert ")")) - (vhdl-insert-keyword " THEN") - (vhdl-comment-insert-inline - (concat "synchronous reset (active " - (if vhdl-reset-active-high "high" "low") ")")) - (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) - (setq position (point)) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "ELSE") - (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "END IF;")) - (when (eq reset-kind 'none) - (setq position (point))) - (insert "\n") (indent-to margin) - (vhdl-insert-keyword "END IF;") - (goto-char position) - reset)) - -(defun vhdl-template-standard-package (library package) - "Insert specification of a standard package. -Include a library specification, if not already there." - (let ((margin (current-indentation))) - (unless (equal library "std") - (unless (or (save-excursion - (vhdl-prepare-search-1 - (and (not (bobp)) - (re-search-backward - (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" - library "\\|end\\)\\>") - nil t) - (match-string 2)))) - (equal (downcase library) "work")) - (vhdl-insert-keyword "LIBRARY ") - (insert library ";") - (when package - (insert "\n") - (indent-to margin)))) - (when package - (vhdl-insert-keyword "USE ") - (insert library "." package) - (vhdl-insert-keyword ".ALL;")))) - -(defun vhdl-template-package-numeric-bit () - "Insert specification of `numeric_bit' package." - (interactive) - (vhdl-template-standard-package "ieee" "numeric_bit")) - -(defun vhdl-template-package-numeric-std () - "Insert specification of `numeric_std' package." - (interactive) - (vhdl-template-standard-package "ieee" "numeric_std")) - -(defun vhdl-template-package-std-logic-1164 () - "Insert specification of `std_logic_1164' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_1164")) - -(defun vhdl-template-package-std-logic-arith () - "Insert specification of `std_logic_arith' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_arith")) - -(defun vhdl-template-package-std-logic-misc () - "Insert specification of `std_logic_misc' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_misc")) - -(defun vhdl-template-package-std-logic-signed () - "Insert specification of `std_logic_signed' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_signed")) - -(defun vhdl-template-package-std-logic-textio () - "Insert specification of `std_logic_textio' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_textio")) - -(defun vhdl-template-package-std-logic-unsigned () - "Insert specification of `std_logic_unsigned' package." - (interactive) - (vhdl-template-standard-package "ieee" "std_logic_unsigned")) - -(defun vhdl-template-package-textio () - "Insert specification of `textio' package." - (interactive) - (vhdl-template-standard-package "std" "textio")) - -(defun vhdl-template-package-fundamental-constants () - "Insert specification of `fundamental_constants' package." - (interactive) - (vhdl-template-standard-package "ieee" "fundamental_constants")) - -(defun vhdl-template-package-material-constants () - "Insert specification of `material_constants' package." - (interactive) - (vhdl-template-standard-package "ieee" "material_constants")) - -(defun vhdl-template-package-energy-systems () - "Insert specification of `energy_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "energy_systems")) - -(defun vhdl-template-package-electrical-systems () - "Insert specification of `electrical_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "electrical_systems")) - -(defun vhdl-template-package-mechanical-systems () - "Insert specification of `mechanical_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "mechanical_systems")) - -(defun vhdl-template-package-radiant-systems () - "Insert specification of `radiant_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "radiant_systems")) - -(defun vhdl-template-package-thermal-systems () - "Insert specification of `thermal_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "thermal_systems")) - -(defun vhdl-template-package-fluidic-systems () - "Insert specification of `fluidic_systems' package." - (interactive) - (vhdl-template-standard-package "ieee" "fluidic_systems")) - -(defun vhdl-template-package-math-complex () - "Insert specification of `math_complex' package." - (interactive) - (vhdl-template-standard-package "ieee" "math_complex")) - -(defun vhdl-template-package-math-real () - "Insert specification of `math_real' package." - (interactive) - (vhdl-template-standard-package "ieee" "math_real")) - -(defun vhdl-template-directive (directive) - "Insert directive." - (unless (= (current-indentation) (current-column)) - (delete-horizontal-space) - (insert " ")) - (insert "-- pragma " directive)) - -(defun vhdl-template-directive-translate-on () - "Insert directive `translate_on'." - (interactive) - (vhdl-template-directive "translate_on")) - -(defun vhdl-template-directive-translate-off () - "Insert directive `translate_off'." - (interactive) - (vhdl-template-directive "translate_off")) - -(defun vhdl-template-directive-synthesis-on () - "Insert directive `synthesis_on'." - (interactive) - (vhdl-template-directive "synthesis_on")) - -(defun vhdl-template-directive-synthesis-off () - "Insert directive `synthesis_off'." - (interactive) - (vhdl-template-directive "synthesis_off")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Header and footer templates - -(defun vhdl-template-header (&optional file-title) - "Insert a VHDL file header." - (interactive) - (unless (equal vhdl-file-header "") - (let (pos) - (save-excursion - (goto-char (point-min)) - (vhdl-insert-string-or-file vhdl-file-header) - (setq pos (point-marker))) - (vhdl-template-replace-header-keywords - (point-min-marker) pos file-title)))) - -(defun vhdl-template-footer () - "Insert a VHDL file footer." - (interactive) - (unless (equal vhdl-file-footer "") - (let (pos) - (save-excursion - (goto-char (point-max)) - (setq pos (point-marker)) - (vhdl-insert-string-or-file vhdl-file-footer) - (unless (= (preceding-char) ?\n) - (insert "\n"))) - (vhdl-template-replace-header-keywords pos (point-max-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 (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 - (goto-char beg) - (while (search-forward "<projectdesc>" end t) - (replace-match project-desc t t)) - (goto-char beg) - (while (search-forward "<filename>" end t) - (replace-match (buffer-name) t t)) - (goto-char beg) - (while (search-forward "<copyright>" end t) - (replace-match vhdl-copyright-string t t)) - (goto-char beg) - (while (search-forward "<author>" end t) - (replace-match "" t t) - (insert (user-full-name)) - (when user-mail-address (insert " <" user-mail-address ">"))) - (goto-char beg) - (while (search-forward "<authorfull>" end t) - (replace-match (user-full-name) t t)) - (goto-char beg) - (while (search-forward "<login>" end t) - (replace-match (user-login-name) t t)) - (goto-char beg) - (while (search-forward "<project>" end t) - (replace-match project-title t t)) - (goto-char beg) - (while (search-forward "<company>" end t) - (replace-match vhdl-company-name t t)) - (goto-char beg) - (while (search-forward "<platform>" end t) - (replace-match vhdl-platform-spec t t)) - (goto-char beg) - (while (search-forward "<standard>" end t) - (replace-match - (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") - ((vhdl-standard-p '93) "'93/02") - ((vhdl-standard-p '08) "'08")) - (when (vhdl-standard-p 'ams) ", VHDL-AMS") - (when (vhdl-standard-p 'math) ", Math Packages")) t t)) - (goto-char beg) - ;; Replace <RCS> with $, so that RCS for the source is - ;; not over-enthusiastic with replacements - (while (search-forward "<RCS>" end t) - (replace-match "$" nil t)) - (goto-char beg) - (while (search-forward "<date>" end t) - (replace-match "" t t) - (vhdl-template-insert-date)) - (goto-char beg) - (let ((year (format-time-string "%Y"))) - (while (search-forward "<year>" end t) - (replace-match year t t))) - (goto-char beg) - (when file-title - (while (search-forward "<title string>" end t) - (replace-match file-title t t)) - (goto-char beg)) - (let (string) - (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)) - (replace-match "" t t) - (setq pos (point)))) - (when pos (goto-char pos)) - (unless is-model - (when (or (not project-title) (equal project-title "")) - (message "You can specify a project title in user option `vhdl-project-alist'")) - (when (or (not project-desc) (equal project-desc "")) - (message "You can specify a project description in user option `vhdl-project-alist'")) - (when (equal vhdl-platform-spec "") - (message "You can specify a platform in user option `vhdl-platform-spec'")) - (when (equal vhdl-company-name "") - (message "You can specify a company name in user option `vhdl-company-name'")))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Comment templates and functions - -(defun vhdl-comment-indent () - "Indent comments." - (let* ((position (point)) - (col - (progn - (forward-line -1) - (if (re-search-forward "--" position t) - (- (current-column) 2) ; existing comment at bol stays there - (goto-char position) - (skip-chars-backward " \t") - (max comment-column ; else indent to comment column - (1+ (current-column))))))) ; except leave at least one space - (goto-char position) - col)) - -(defun vhdl-comment-insert () - "Start a comment at the end of the line. -If on line with code, indent at least `comment-column'. -If starting after end-comment-column, start a new line." - (interactive) - (when (> (current-column) end-comment-column) (newline-and-indent)) - (if (or (looking-at "\\s-*$") ; end of line - (and (not unread-command-events) ; called with key binding or menu - (not (end-of-line)))) - (let (margin) - (while (= (preceding-char) ?-) (delete-char -1)) - (setq margin (current-column)) - (delete-horizontal-space) - (if (bolp) - (progn (indent-to margin) (insert "--")) - (insert " ") - (indent-to comment-column) - (insert "--")) - (if (not unread-command-events) (insert " "))) - ;; else code following current point implies commenting out code - (let (next-input code) - (while (= (preceding-char) ?-) (delete-char -2)) - (while (= (setq next-input (read-char)) 13) ; CR - (insert "--") ; or have a space after it? - (forward-char -2) - (forward-line 1) - (message "Enter CR if commenting out a line of code.") - (setq code t)) - (unless code - (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? - (push (vhdl-character-to-event next-input) ; pushback the char - unread-command-events)))) - -(defun vhdl-comment-display (&optional line-exists) - "Add 2 comment lines at the current indent, making a display comment." - (interactive) - (let ((margin (current-indentation))) - (unless line-exists (vhdl-comment-display-line)) - (insert "\n") (indent-to margin) - (insert "\n") (indent-to margin) - (vhdl-comment-display-line) - (end-of-line -0) - (insert "-- "))) - -(defun vhdl-comment-display-line () - "Displays one line of dashes." - (interactive) - (while (= (preceding-char) ?-) (delete-char -2)) - (insert "--") - (let* ((col (current-column)) - (len (- end-comment-column col))) - (insert-char vhdl-comment-display-line-char len))) - -(defun vhdl-comment-append-inline () - "Append empty inline comment to current line." - (interactive) - (end-of-line) - (delete-horizontal-space) - (insert " ") - (indent-to comment-column) - (insert "-- ")) - -(defun vhdl-comment-insert-inline (&optional string always-insert) - "Insert inline comment." - (when (or (and string (or vhdl-self-insert-comments always-insert)) - (and (not string) vhdl-prompt-for-comments)) - (let ((position (point))) - (insert " ") - (indent-to comment-column) - (insert "-- ") - (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)))))) - -(defun vhdl-comment-block () - "Insert comment for code block." - (when vhdl-prompt-for-comments - (let ((final-pos (point-marker))) - (vhdl-prepare-search-2 - (when (and (re-search-backward "^\\s-*begin\\>" nil t) - (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) - (let (margin) - (back-to-indentation) - (setq margin (current-column)) - (end-of-line -0) - (if (bobp) - (progn (insert "\n") (forward-line -1)) - (insert "\n")) - (indent-to margin) - (insert "-- purpose: ") - (unless (vhdl-template-field "[description]" nil t) - (vhdl-line-kill-entire))))) - (goto-char final-pos)))) - -(defun vhdl-comment-uncomment-region (beg end &optional _arg) - "Comment out region if not commented out, uncomment otherwise." - (interactive "r") - (save-excursion - (goto-char (1- end)) - (end-of-line) - (setq end (point-marker)) - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - (if (looking-at (concat "\\s-*" comment-start)) - (comment-region beg end '(4)) - (comment-region beg end)))) - -(defun vhdl-comment-uncomment-line (&optional arg) - "Comment out line if not commented out, uncomment otherwise." - (interactive "p") - (save-excursion - (beginning-of-line) - (let ((position (point))) - (forward-line (or arg 1)) - (vhdl-comment-uncomment-region position (point))))) - -(defun vhdl-comment-kill-region (beg end) - "Kill comments in region." - (interactive "r") - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char beg) - (beginning-of-line) - (while (< (point) end) - (if (looking-at "^\\(\\s-*--.*\n\\)") - (progn (delete-region (match-beginning 1) (match-end 1))) - (beginning-of-line 2))))) - -(defun vhdl-comment-kill-inline-region (beg end) - "Kill inline comments in region." - (interactive "r") - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char beg) - (beginning-of-line) - (while (< (point) end) - (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$") - (delete-region (match-beginning 1) (match-end 1))) - (beginning-of-line 2)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Subtemplates - -(defun vhdl-template-begin-end (construct name margin &optional empty-lines) - "Insert a begin ... end pair with optional name after the end. -Point is left between them." - (let (position) - (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "BEGIN") - (when (and (or construct name) vhdl-self-insert-comments) - (insert " --") - (when construct (insert " ") (vhdl-insert-keyword construct)) - (when name (insert " " name))) - (insert "\n") - (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (setq position (point)) - (insert "\n") - (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "END") - (when construct (insert " ") (vhdl-insert-keyword construct)) - (insert (if name (concat " " name) "") ";") - (goto-char position))) - -(defun vhdl-template-argument-list (&optional is-function) - "Read from user a procedure or function argument list." - (insert " (") - (let ((margin (current-column)) - ;; (start (point)) - (end-pos (point)) - not-empty interface semicolon-pos) - (unless vhdl-argument-list-indent - (setq margin (+ (current-indentation) vhdl-basic-offset)) - (insert "\n") - (indent-to margin)) - (setq interface (vhdl-template-field - (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") - " " t)) - (while (vhdl-template-field "[names]" nil t) - (setq not-empty t) - (insert " : ") - (unless is-function - (if (and interface (equal (upcase interface) "CONSTANT")) - (vhdl-insert-keyword "IN ") - (vhdl-template-field "[IN | OUT | INOUT]" " " t))) - (vhdl-template-field "type") - (setq semicolon-pos (point)) - (insert ";") - (vhdl-comment-insert-inline) - (setq end-pos (point)) - (insert "\n") - (indent-to margin) - (setq interface (vhdl-template-field - (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") - " " t))) - (delete-region end-pos (point)) - (when semicolon-pos (goto-char semicolon-pos)) - (if not-empty - (progn (delete-char 1) (insert ")")) - (delete-char -2)))) - -(defun vhdl-template-generic-list (optional &optional no-value) - "Read from user a generic spec argument list." - (let (margin - (start (point))) - (vhdl-insert-keyword "GENERIC (") - (setq margin (current-column)) - (unless vhdl-argument-list-indent - (let ((position (point))) - (back-to-indentation) - (setq margin (+ (current-column) vhdl-basic-offset)) - (goto-char position) - (insert "\n") - (indent-to margin))) - (let ((vhdl-generics (vhdl-template-field - (concat (and optional "[") "name" - (and no-value "s") (and optional "]")) - nil optional))) - (if (not vhdl-generics) - (if optional - (progn (vhdl-line-kill-entire) (end-of-line -0) - (unless vhdl-argument-list-indent - (vhdl-line-kill-entire) (end-of-line -0))) - (vhdl-template-undo start (point)) - nil ) - (insert " : ") - (let (semicolon-pos end-pos) - (while vhdl-generics - (vhdl-template-field "type") - (if no-value - (progn (setq semicolon-pos (point)) - (insert ";")) - (insert " := ") - (unless (vhdl-template-field "[value]" nil t) - (delete-char -4)) - (setq semicolon-pos (point)) - (insert ";")) - (vhdl-comment-insert-inline) - (setq end-pos (point)) - (insert "\n") - (indent-to margin) - (setq vhdl-generics (vhdl-template-field - (concat "[name" (and no-value "s") "]") - " : " t))) - (delete-region end-pos (point)) - (goto-char semicolon-pos) - (insert ")") - (end-of-line) - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) - t))))) - -(defun vhdl-template-port-list (optional) - "Read from user a port spec argument list." - (let ((start (point)) - margin vhdl-ports object) - (vhdl-insert-keyword "PORT (") - (setq margin (current-column)) - (unless vhdl-argument-list-indent - (let ((position (point))) - (back-to-indentation) - (setq margin (+ (current-column) vhdl-basic-offset)) - (goto-char position) - (insert "\n") - (indent-to margin))) - (when (vhdl-standard-p 'ams) - (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" - " " t))) - (setq vhdl-ports (vhdl-template-field - (concat (and optional "[") "names" (and optional "]")) - nil optional)) - (if (not vhdl-ports) - (if optional - (progn (vhdl-line-kill-entire) (end-of-line -0) - (unless vhdl-argument-list-indent - (vhdl-line-kill-entire) (end-of-line -0))) - (vhdl-template-undo start (point)) - nil) - (insert " : ") - (let (semicolon-pos end-pos) - (while vhdl-ports - (cond ((or (null object) (equal "SIGNAL" (upcase object))) - (vhdl-template-field "IN | OUT | INOUT" " ")) - ((equal "QUANTITY" (upcase object)) - (vhdl-template-field "[IN | OUT]" " " t))) - (vhdl-template-field - (if (and object (equal "TERMINAL" (upcase object))) - "nature" "type")) - (setq semicolon-pos (point)) - (insert ";") - (vhdl-comment-insert-inline) - (setq end-pos (point)) - (insert "\n") - (indent-to margin) - (when (vhdl-standard-p 'ams) - (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" - " " t))) - (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) - (delete-region end-pos (point)) - (goto-char semicolon-pos) - (insert ")") - (end-of-line) - (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) - t)))) - -(defun vhdl-template-generate-body (margin label) - "Insert body for generate template." - (vhdl-insert-keyword " GENERATE") - (insert "\n\n") - (indent-to margin) - (vhdl-insert-keyword "END GENERATE ") - (insert label ";") - (end-of-line 0) - (indent-to (+ margin vhdl-basic-offset))) - -(defun vhdl-template-insert-date () - "Insert date in appropriate format." - (interactive) - (insert - (cond - ;; 'american, 'european, 'scientific kept for backward compatibility - ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) - ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) - ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) - (t (format-time-string vhdl-date-format nil))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Help functions - -(defun vhdl-electric-space (count) - "Expand abbreviations and self-insert space(s), do `indent-new-comment-line' -if in comment and past end-comment-column." - (interactive "p") - (cond ((vhdl-in-comment-p) - (self-insert-command count) - (cond ((>= (current-column) (+ 2 end-comment-column)) - (backward-char 1) - (skip-chars-backward "^ \t\n\r\f") - (indent-new-comment-line) - (skip-chars-forward "^ \t\n\r\f") - (forward-char 1)) - ((>= (current-column) end-comment-column) - (indent-new-comment-line)) - (t nil))) - ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) - (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) - (vhdl-prepare-search-1 - (or (expand-abbrev) (vhdl-fix-case-word -1))) - (self-insert-command count)) - (t (self-insert-command count)))) - -(defun vhdl-template-field (prompt &optional follow-string optional - begin end is-string default) - "Prompt for string and insert it in buffer with optional FOLLOW-STRING. -If OPTIONAL is nil, the prompt is left if an empty string is inserted. If -an empty string is inserted, return nil and call `vhdl-template-undo' for -the region between BEGIN and END. IS-STRING indicates whether a string -with double-quotes is to be inserted. DEFAULT specifies a default string." - (let ((position (point)) - string) - (insert "<" prompt ">") - (setq string - (condition-case () - (read-from-minibuffer (concat prompt ": ") - (or (and is-string '("\"\"" . 2)) default) - vhdl-minibuffer-local-map) - (quit (if (and optional begin end) - (progn (beep) "") - (keyboard-quit))))) - (when (or (not (equal string "")) optional) - (delete-region position (point))) - (when (and (equal string "") optional begin end) - (vhdl-template-undo begin end) - (message "Template aborted")) - (unless (equal string "") - (insert string) - (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords - vhdl-keywords-regexp) - (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types - vhdl-types-regexp) - (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes - (concat "'" vhdl-attributes-regexp)) - (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values - vhdl-enum-values-regexp) - (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants - vhdl-constants-regexp)) - (when (or (not (equal string "")) (not optional)) - (insert (or follow-string ""))) - (if (equal string "") nil string))) - -(defun vhdl-decision-query (string prompt &optional optional) - "Query a decision from the user." - (let ((start (point))) - (when string (vhdl-insert-keyword (concat string " "))) - (message "%s" (or prompt "")) - (let ((char (read-char))) - (delete-region start (point)) - (if (and optional (eq char ?\r)) - (progn (insert " ") - (unexpand-abbrev) - (throw 'abort "ERROR: Template aborted")) - char)))) - -(defun vhdl-insert-keyword (keyword) - "Insert KEYWORD and adjust case." - (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) - -(defun vhdl-case-keyword (keyword) - "Adjust case of KEYWORD." - (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) - -(defun vhdl-case-word (num) - "Adjust case of following NUM words." - (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) - -(defun vhdl-minibuffer-tab (&optional arg) - "If preceding character is part of a word or a paren then hippie-expand, -else insert tab (used for word completion in VHDL minibuffer)." - (interactive "P") - (cond - ;; expand word - ((= (char-syntax (preceding-char)) ?w) - (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) - (case-replace nil) - (hippie-expand-only-buffers - (or (and (boundp 'hippie-expand-only-buffers) - hippie-expand-only-buffers) - '(vhdl-mode)))) - (vhdl-expand-abbrev arg))) - ;; expand parenthesis - ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) - (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) - (case-replace nil)) - (vhdl-expand-paren arg))) - ;; insert tab - (t (insert-tab)))) - -(defun vhdl-template-search-prompt () - "Search for left out template prompts and query again." - (interactive) - (vhdl-prepare-search-2 - (when (or (re-search-forward - (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) - (re-search-backward - (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) - (let ((string (match-string 1))) - (replace-match "") - (vhdl-template-field string))))) - -(defun vhdl-template-undo (begin end) - "Undo aborted template by deleting region and unexpanding the keyword." - (cond (vhdl-template-invoked-by-hook - (goto-char end) - (insert " ") - (delete-region begin end) - (unexpand-abbrev)) - (t (delete-region begin end)))) - -(defun vhdl-insert-string-or-file (string) - "Insert STRING or file contents if STRING is an existing file name." - (unless (equal string "") - (let ((file-name - (progn (string-match "^\\([^\n]+\\)" string) - (vhdl-resolve-env-variable (match-string 1 string))))) - (if (file-exists-p file-name) - (forward-char (cadr (insert-file-contents file-name))) - (insert string))))) - -(defun vhdl-beginning-of-block () - "Move cursor to the beginning of the enclosing block." - (let (pos) - (vhdl-prepare-search-2 - (save-excursion - (beginning-of-line) - ;; search backward for block beginning or end - (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) - ;; not consider subprogram declarations - (or (and (match-string 5) - (save-match-data - (save-excursion - (goto-char (match-end 5)) - (forward-word-strictly 1) - (vhdl-forward-syntactic-ws) - (when (looking-at "(") - (forward-sexp)) - (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) - (match-string 1))) - ;; not consider configuration specifications - (and (match-string 6) - (save-match-data - (save-excursion - (vhdl-end-of-block) - (beginning-of-line) - (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) - (match-string 2)) - ;; skip subblock if block end found - (vhdl-beginning-of-block)))) - (when pos (goto-char pos)))) - -(defun vhdl-end-of-block () - "Move cursor to the end of the enclosing block." - (let (pos) - (vhdl-prepare-search-2 - (save-excursion - (end-of-line) - ;; search forward for block beginning or end - (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) - ;; not consider subprogram declarations - (or (and (match-string 5) - (save-match-data - (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) - (match-string 1))) - ;; not consider configuration specifications - (and (match-string 6) - (save-match-data - (save-excursion - (vhdl-end-of-block) - (beginning-of-line) - (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) - (not (match-string 2))) - ;; skip subblock if block beginning found - (vhdl-end-of-block)))) - (when pos (goto-char pos)))) - -(defun vhdl-sequential-statement-p () - "Check if point is within sequential statement part." - (let ((start (point))) - (save-excursion - (vhdl-prepare-search-2 - ;; is sequential statement if ... - (and (re-search-backward "^\\s-*begin\\>" nil t) - ;; ... point is between "begin" and "end" of ... - (progn (vhdl-end-of-block) - (< start (point))) - ;; ... a sequential block - (progn (vhdl-beginning-of-block) - (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>"))))))) - -(defun vhdl-in-argument-list-p () - "Check if within an argument list." - (save-excursion - (vhdl-prepare-search-2 - (or (string-match "arglist" - (format "%s" (caar (vhdl-get-syntactic-context)))) - (progn (beginning-of-line) - (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Abbrev hooks - -(defun vhdl-hooked-abbrev (func) - "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, -but not if inside a comment or quote." - (if (or (vhdl-in-literal) - (save-excursion - (forward-word-strictly -1) - (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) - (progn - (insert " ") - (unexpand-abbrev) - (backward-word-strictly 1) - (vhdl-case-word 1) - (delete-char 1)) - (if (not vhdl-electric-mode) - (progn - (insert " ") - (unexpand-abbrev) - (backward-word-strictly 1) - (vhdl-case-word 1) - (delete-char 1)) - (let ((invoke-char vhdl-last-input-event) - (abbrev-mode -1) - (vhdl-template-invoked-by-hook t)) - (let ((caught (catch 'abort - (funcall func)))) - (when (stringp caught) (message "%s" caught))) - (when (= invoke-char ?-) (setq abbrev-start-location (point))) - ;; delete CR which is still in event queue - (if (fboundp 'enqueue-eval-event) - (enqueue-eval-event 'delete-char -1) - (push (vhdl-character-to-event ?\177) ; push back a delete char - unread-command-events)))))) - -(defun vhdl-template-alias-hook () - (vhdl-hooked-abbrev 'vhdl-template-alias)) -(defun vhdl-template-architecture-hook () - (vhdl-hooked-abbrev 'vhdl-template-architecture)) -(defun vhdl-template-assert-hook () - (vhdl-hooked-abbrev 'vhdl-template-assert)) -(defun vhdl-template-attribute-hook () - (vhdl-hooked-abbrev 'vhdl-template-attribute)) -(defun vhdl-template-block-hook () - (vhdl-hooked-abbrev 'vhdl-template-block)) -(defun vhdl-template-break-hook () - (vhdl-hooked-abbrev 'vhdl-template-break)) -(defun vhdl-template-case-hook () - (vhdl-hooked-abbrev 'vhdl-template-case)) -(defun vhdl-template-component-hook () - (vhdl-hooked-abbrev 'vhdl-template-component)) -(defun vhdl-template-instance-hook () - (vhdl-hooked-abbrev 'vhdl-template-instance)) -(defun vhdl-template-conditional-signal-asst-hook () - (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) -(defun vhdl-template-configuration-hook () - (vhdl-hooked-abbrev 'vhdl-template-configuration)) -(defun vhdl-template-constant-hook () - (vhdl-hooked-abbrev 'vhdl-template-constant)) -(defun vhdl-template-context-hook () - (vhdl-hooked-abbrev 'vhdl-template-context)) -(defun vhdl-template-disconnect-hook () - (vhdl-hooked-abbrev 'vhdl-template-disconnect)) -(defun vhdl-template-display-comment-hook () - (vhdl-hooked-abbrev 'vhdl-comment-display)) -(defun vhdl-template-else-hook () - (vhdl-hooked-abbrev 'vhdl-template-else)) -(defun vhdl-template-elsif-hook () - (vhdl-hooked-abbrev 'vhdl-template-elsif)) -(defun vhdl-template-entity-hook () - (vhdl-hooked-abbrev 'vhdl-template-entity)) -(defun vhdl-template-exit-hook () - (vhdl-hooked-abbrev 'vhdl-template-exit)) -(defun vhdl-template-file-hook () - (vhdl-hooked-abbrev 'vhdl-template-file)) -(defun vhdl-template-for-hook () - (vhdl-hooked-abbrev 'vhdl-template-for)) -(defun vhdl-template-function-hook () - (vhdl-hooked-abbrev 'vhdl-template-function)) -(defun vhdl-template-generic-hook () - (vhdl-hooked-abbrev 'vhdl-template-generic)) -(defun vhdl-template-group-hook () - (vhdl-hooked-abbrev 'vhdl-template-group)) -(defun vhdl-template-library-hook () - (vhdl-hooked-abbrev 'vhdl-template-library)) -(defun vhdl-template-limit-hook () - (vhdl-hooked-abbrev 'vhdl-template-limit)) -(defun vhdl-template-if-hook () - (vhdl-hooked-abbrev 'vhdl-template-if)) -(defun vhdl-template-bare-loop-hook () - (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) -(defun vhdl-template-map-hook () - (vhdl-hooked-abbrev 'vhdl-template-map)) -(defun vhdl-template-nature-hook () - (vhdl-hooked-abbrev 'vhdl-template-nature)) -(defun vhdl-template-next-hook () - (vhdl-hooked-abbrev 'vhdl-template-next)) -(defun vhdl-template-others-hook () - (vhdl-hooked-abbrev 'vhdl-template-others)) -(defun vhdl-template-package-hook () - (vhdl-hooked-abbrev 'vhdl-template-package)) -(defun vhdl-template-port-hook () - (vhdl-hooked-abbrev 'vhdl-template-port)) -(defun vhdl-template-procedural-hook () - (vhdl-hooked-abbrev 'vhdl-template-procedural)) -(defun vhdl-template-procedure-hook () - (vhdl-hooked-abbrev 'vhdl-template-procedure)) -(defun vhdl-template-process-hook () - (vhdl-hooked-abbrev 'vhdl-template-process)) -(defun vhdl-template-quantity-hook () - (vhdl-hooked-abbrev 'vhdl-template-quantity)) -(defun vhdl-template-report-hook () - (vhdl-hooked-abbrev 'vhdl-template-report)) -(defun vhdl-template-return-hook () - (vhdl-hooked-abbrev 'vhdl-template-return)) -(defun vhdl-template-selected-signal-asst-hook () - (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) -(defun vhdl-template-signal-hook () - (vhdl-hooked-abbrev 'vhdl-template-signal)) -(defun vhdl-template-subnature-hook () - (vhdl-hooked-abbrev 'vhdl-template-subnature)) -(defun vhdl-template-subtype-hook () - (vhdl-hooked-abbrev 'vhdl-template-subtype)) -(defun vhdl-template-terminal-hook () - (vhdl-hooked-abbrev 'vhdl-template-terminal)) -(defun vhdl-template-type-hook () - (vhdl-hooked-abbrev 'vhdl-template-type)) -(defun vhdl-template-use-hook () - (vhdl-hooked-abbrev 'vhdl-template-use)) -(defun vhdl-template-variable-hook () - (vhdl-hooked-abbrev 'vhdl-template-variable)) -(defun vhdl-template-wait-hook () - (vhdl-hooked-abbrev 'vhdl-template-wait)) -(defun vhdl-template-when-hook () - (vhdl-hooked-abbrev 'vhdl-template-when)) -(defun vhdl-template-while-loop-hook () - (vhdl-hooked-abbrev 'vhdl-template-while-loop)) -(defun vhdl-template-with-hook () - (vhdl-hooked-abbrev 'vhdl-template-with)) -(defun vhdl-template-and-hook () - (vhdl-hooked-abbrev 'vhdl-template-and)) -(defun vhdl-template-or-hook () - (vhdl-hooked-abbrev 'vhdl-template-or)) -(defun vhdl-template-nand-hook () - (vhdl-hooked-abbrev 'vhdl-template-nand)) -(defun vhdl-template-nor-hook () - (vhdl-hooked-abbrev 'vhdl-template-nor)) -(defun vhdl-template-xor-hook () - (vhdl-hooked-abbrev 'vhdl-template-xor)) -(defun vhdl-template-xnor-hook () - (vhdl-hooked-abbrev 'vhdl-template-xnor)) -(defun vhdl-template-not-hook () - (vhdl-hooked-abbrev 'vhdl-template-not)) - -(defun vhdl-template-default-hook () - (vhdl-hooked-abbrev 'vhdl-template-default)) -(defun vhdl-template-default-indent-hook () - (vhdl-hooked-abbrev 'vhdl-template-default-indent)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Template insertion from completion list - -(defun vhdl-template-insert-construct (name) - "Insert the built-in construct template with NAME." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Construct name: " - vhdl-template-construct-alist nil t)))) - (vhdl-template-insert-fun - (cadr (assoc name vhdl-template-construct-alist)))) - -(defun vhdl-template-insert-package (name) - "Insert the built-in package template with NAME." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Package name: " - vhdl-template-package-alist nil t)))) - (vhdl-template-insert-fun - (cadr (assoc name vhdl-template-package-alist)))) - -(defun vhdl-template-insert-directive (name) - "Insert the built-in directive template with NAME." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Directive name: " - vhdl-template-directive-alist nil t)))) - (vhdl-template-insert-fun - (cadr (assoc name vhdl-template-directive-alist)))) - -(defun vhdl-template-insert-fun (fun) - "Call FUN to insert a built-in template." - (let ((caught (catch 'abort (when fun (funcall fun))))) - (when (stringp caught) (message "%s" caught)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Models -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vhdl-model-insert (model-name) - "Insert the user model with name MODEL-NAME." - (interactive - (let ((completion-ignore-case t)) - (list (completing-read "Model name: " vhdl-model-alist)))) - (indent-according-to-mode) - (let ((start (point-marker)) - (margin (current-indentation)) - model position prompt string end) - (vhdl-prepare-search-2 - (when (setq model (assoc model-name vhdl-model-alist)) - ;; insert model - (beginning-of-line) - (delete-horizontal-space) - (goto-char start) - (vhdl-insert-string-or-file (nth 1 model)) - (setq end (point-marker)) - ;; indent code - (goto-char start) - (beginning-of-line) - (while (< (point) end) - (unless (looking-at "^$") - (insert-char ? margin)) - (beginning-of-line 2)) - (goto-char start) - ;; insert clock - (unless (equal "" vhdl-clock-name) - (while (re-search-forward "<clock>" end t) - (replace-match vhdl-clock-name))) - (goto-char start) - ;; insert reset - (unless (equal "" vhdl-reset-name) - (while (re-search-forward "<reset>" end t) - (replace-match vhdl-reset-name))) - ;; replace header prompts - (vhdl-template-replace-header-keywords start end nil t) - (goto-char start) - ;; query other prompts - (while (re-search-forward - (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) - (unless (equal "cursor" (match-string 1)) - (setq position (match-beginning 1)) - (setq prompt (match-string 1)) - (replace-match "") - (setq string (vhdl-template-field prompt nil t)) - ;; replace occurrences of same prompt - (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) - (replace-match (or string ""))) - (goto-char position))) - (goto-char start) - ;; goto final position - (if (re-search-forward "<cursor>" end t) - (replace-match "") - (goto-char end)))))) - -(defun vhdl-model-defun () - "Define help and hook functions for user models." - (let ((model-alist vhdl-model-alist) - model-name model-keyword) - (while model-alist - ;; define functions for user models that can be invoked from menu and key - ;; bindings and which themselves call `vhdl-model-insert' with the model - ;; name as argument - (setq model-name (nth 0 (car model-alist))) - (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () - ,(concat "Insert model for \"" model-name "\".") - (interactive) - (vhdl-model-insert ,model-name))) - ;; define hooks for user models that are invoked from keyword abbrevs - (setq model-keyword (nth 3 (car model-alist))) - (unless (equal model-keyword "") - (eval `(defun - ,(vhdl-function-name - "vhdl-model" model-name "hook") - () - (vhdl-hooked-abbrev - ',(vhdl-function-name "vhdl-model" model-name))))) - (setq model-alist (cdr model-alist))))) - -(vhdl-model-defun) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Port translation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar vhdl-port-list nil - "Variable to hold last port map parsed.") -;; structure: (parenthesized expression means list of such entries) -;; (ent-name -;; ((generic-names) generic-type generic-init generic-comment group-comment) -;; ((port-names) port-object port-direct port-type port-comment group-comment) -;; (lib-name pack-key)) - -(defun vhdl-parse-string (string &optional optional) - "Check that the text following point matches the regexp in STRING." - (if (looking-at string) - (progn (goto-char (match-end 0)) - (when (vhdl-in-literal) - (end-of-line)) - (point)) - (unless optional - (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" - (vhdl-current-line) string))) - nil)) - -(defun vhdl-replace-string (regexp-cons string &optional adjust-case) - "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." - (vhdl-prepare-search-1 - (if (string-match (car regexp-cons) string) - (if adjust-case - (funcall vhdl-file-name-case - (replace-match (cdr regexp-cons) t nil string)) - (replace-match (cdr regexp-cons) t nil string)) - string))) - -(defun vhdl-parse-group-comment () - "Parse comment and empty lines between groups of lines." - (let ((start (point)) - string) - (vhdl-forward-comment (point-max)) - (setq string (buffer-substring-no-properties start (point))) - (vhdl-forward-syntactic-ws) - ;; strip off leading blanks and first newline - (while (string-match "^\\(\\s-+\\)" string) - (setq string (concat (substring string 0 (match-beginning 1)) - (substring string (match-end 1))))) - (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) - (substring string 1) - string))) - -(defun vhdl-paste-group-comment (string indent) - "Paste comment and empty lines from STRING between groups of lines with INDENT." - (let ((pos (point-marker))) - (when (> indent 0) - (while (string-match "^\\(--\\)" string) - (setq string (concat (substring string 0 (match-beginning 1)) - (make-string indent ? ) - (substring string (match-beginning 1)))))) - (beginning-of-line) - (insert string) - (goto-char pos))) - -(defvar vhdl-port-flattened nil - "Indicates whether a port has been flattened.") - -(defun vhdl-port-flatten (&optional as-alist) - "Flatten port list so that only one generic/port exists per line. -This operation is performed on an internally stored port and is only -reflected in a subsequent paste operation." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port has been read") - (message "Flattening port for next paste...") - (let ((new-vhdl-port-list (list (car vhdl-port-list))) - (old-vhdl-port-list (cdr vhdl-port-list)) - old-port-list new-port-list old-port new-port names) - ;; traverse port list and flatten entries - (while (cdr old-vhdl-port-list) - (setq old-port-list (car old-vhdl-port-list)) - (setq new-port-list nil) - (while old-port-list - (setq old-port (car old-port-list)) - (setq names (car old-port)) - (while names - (setq new-port (cons (if as-alist (car names) (list (car names))) - (cdr old-port))) - (setq new-port-list (append new-port-list (list new-port))) - (setq names (cdr names))) - (setq old-port-list (cdr old-port-list))) - (setq old-vhdl-port-list (cdr old-vhdl-port-list)) - (setq new-vhdl-port-list (append new-vhdl-port-list - (list new-port-list)))) - (setq vhdl-port-list - (append new-vhdl-port-list (list old-vhdl-port-list)) - vhdl-port-flattened t) - (message "Flattening port for next paste...done")))) - -(defvar vhdl-port-reversed-direction nil - "Indicates whether port directions are reversed.") - -(defun vhdl-port-reverse-direction () - "Reverse direction for all ports (useful in testbenches). -This operation is performed on an internally stored port and is only -reflected in a subsequent paste operation." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port has been read") - (message "Reversing port directions for next paste...") - (let ((port-list (nth 2 vhdl-port-list)) - port-dir-car port-dir) - ;; traverse port list and reverse directions - (while port-list - (setq port-dir-car (cddr (car port-list)) - port-dir (car port-dir-car)) - (setcar port-dir-car - (cond ((equal port-dir "in") "out") - ((equal port-dir "IN") "OUT") - ((equal port-dir "out") "in") - ((equal port-dir "OUT") "IN") - (t port-dir))) - (setq port-list (cdr port-list))) - (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) - (message "Reversing port directions for next paste...done")))) - -(defun vhdl-port-copy () - "Get generic and port information from an entity or component declaration." - (interactive) - (save-excursion - (let (parse-error end-of-list - decl-type name generic-list port-list context-clause - object names direct type init comment group-comment) - (vhdl-prepare-search-2 - (setq - parse-error - (catch 'parse - ;; check if within entity or component declaration - (end-of-line) - (when (or (not (re-search-backward - "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) - (equal "END" (upcase (match-string 1)))) - (throw 'parse "ERROR: Not within an entity or component declaration")) - (setq decl-type (downcase (match-string-no-properties 1))) - (forward-word-strictly 1) - (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") - (setq name (match-string-no-properties 1)) - (message "Reading port of %s \"%s\"..." decl-type name) - (vhdl-forward-syntactic-ws) - ;; parse generic clause - (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t) - ;; parse group comment and spacing - (setq group-comment (vhdl-parse-group-comment)) - (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) - (while (not end-of-list) - ;; parse names (accept extended identifiers) - (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") - (setq names (list (match-string-no-properties 1))) - (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) - (setq names - (append names (list (match-string-no-properties 1))))) - ;; parse type - (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)") - (setq type (match-string-no-properties 1)) - (when (vhdl-in-comment-p) ; if stuck in comment - (setq type (concat type (and (vhdl-parse-string ".*") - (match-string-no-properties 0))))) - (setq comment nil) - (while (looking-at "(") - (setq type - (concat type - (buffer-substring-no-properties - (point) (progn (forward-sexp) (point))) - (and (vhdl-parse-string "\\([^():;\n]*\\)" t) - (match-string-no-properties 1))))) - ;; special case: closing parenthesis is on separate line - (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) - (setq comment (substring type (match-beginning 2))) - (setq type (substring type 0 (match-beginning 1)))) - ;; strip of trailing group-comment - (when (string-match "\\S-\\s-*\\'" type) - (setq type (substring type 0 (1+ (match-beginning 0))))) - ;; parse initialization expression - (setq init nil) - (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) - (vhdl-parse-string "\\([^();\n]*\\)") - (setq init (match-string-no-properties 1)) - (while (looking-at "(") - (setq init - (concat init - (buffer-substring-no-properties - (point) (progn (forward-sexp) (point))) - (and (vhdl-parse-string "\\([^();\n]*\\)" t) - (match-string-no-properties 1)))))) - ;; special case: closing parenthesis is on separate line - (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) - (setq comment (substring init (match-beginning 2))) - (setq init (substring init 0 (match-beginning 1))) - (vhdl-forward-syntactic-ws)) - (skip-chars-forward " \t") - ;; parse inline comment, special case: as above, no initial. - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - (vhdl-forward-syntactic-ws) - (setq end-of-list (vhdl-parse-string ")" t)) - (vhdl-parse-string "\\s-*;\\s-*") - ;; parse inline comment - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - ;; save everything in list - (setq generic-list (append generic-list - (list (list names type init - comment group-comment)))) - ;; parse group comment and spacing - (setq group-comment (vhdl-parse-group-comment)))) - ;; parse port clause - (when (vhdl-parse-string "port[ \t\n\r\f]*(" t) - ;; parse group comment and spacing - (setq group-comment (vhdl-parse-group-comment)) - (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) - (while (not end-of-list) - ;; parse object - (setq object - (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t) - (match-string-no-properties 1))) - ;; parse names (accept extended identifiers) - (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") - (setq names (list (match-string-no-properties 1))) - (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) - (setq names (append names (list (match-string-no-properties 1))))) - ;; parse direction - (vhdl-parse-string ":[ \t\n\r\f]*") - (setq direct - (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t) - (match-string-no-properties 1))) - ;; parse type - (vhdl-parse-string "\\([^();\n]+\\)") - (setq type (match-string-no-properties 1)) - (when (vhdl-in-comment-p) ; if stuck in comment - (setq type (concat type (and (vhdl-parse-string ".*") - (match-string-no-properties 0))))) - (setq comment nil) - (while (looking-at "(") - (setq type (concat type - (buffer-substring-no-properties - (point) (progn (forward-sexp) (point))) - (and (vhdl-parse-string "\\([^();\n]*\\)" t) - (match-string-no-properties 1))))) - ;; special case: closing parenthesis is on separate line - (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) - (setq comment (substring type (match-beginning 2))) - (setq type (substring type 0 (match-beginning 1)))) - ;; strip of trailing group-comment - (when (string-match "\\S-\\s-*\\'" type) - (setq type (substring type 0 (1+ (match-beginning 0))))) - (vhdl-forward-syntactic-ws) - (setq end-of-list (vhdl-parse-string ")" t)) - (vhdl-parse-string "\\s-*;\\s-*") - ;; parse inline comment - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - ;; save everything in list - (setq port-list (append port-list - (list (list names object direct type - comment group-comment)))) - ;; parse group comment and spacing - (setq group-comment (vhdl-parse-group-comment)))) - ;; parse context clause - (setq context-clause (vhdl-scan-context-clause)) -; ;; add surrounding package to context clause -; (when (and (equal decl-type "component") -; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) -; (setq context-clause -; (append context-clause -; (list (cons (vhdl-work-library) -; (match-string-no-properties 1)))))) - (message "Reading port of %s \"%s\"...done" decl-type name) - nil))) - ;; finish parsing - (if parse-error - (error parse-error) - (setq vhdl-port-list (list name generic-list port-list context-clause) - vhdl-port-reversed-direction nil - vhdl-port-flattened nil))))) - -(defun vhdl-port-paste-context-clause (&optional exclude-pack-name) - "Paste a context clause." - (let (;; (margin (current-indentation)) - (clause-list (nth 3 vhdl-port-list)) - clause) - (while clause-list - (setq clause (car clause-list)) - (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) - (downcase exclude-pack-name))) - (save-excursion - (re-search-backward - (concat "^\\s-*use\\s-+" (car clause) - "." (cdr clause) "\\>") - nil t))) - (vhdl-template-standard-package (car clause) (cdr clause)) - (insert "\n")) - (setq clause-list (cdr clause-list))))) - -(defun vhdl-port-paste-generic (&optional no-init) - "Paste a generic clause." - (let ((margin (current-indentation)) - (generic-list (nth 1 vhdl-port-list)) - list-margin start names generic) - ;; paste generic clause - (when generic-list - (setq start (point)) - (vhdl-insert-keyword "GENERIC (") - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while generic-list - (setq generic (car generic-list)) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments '(decl always)) - (vhdl-paste-group-comment (nth 4 generic) list-margin)) - ;; paste names - (setq names (nth 0 generic)) - (while names - (insert (car names)) - (setq names (cdr names)) - (when names (insert ", "))) - ;; paste type - (insert " : " (nth 1 generic)) - ;; paste initialization - (when (and (not no-init) (nth 2 generic)) - (insert " := " (nth 2 generic))) - (unless (cdr generic-list) (insert ")")) - (insert ";") - ;; paste comment - (when (and vhdl-include-port-comments (nth 3 generic)) - (vhdl-comment-insert-inline (nth 3 generic) t)) - (setq generic-list (cdr generic-list)) - (when generic-list (insert "\n") (indent-to list-margin))) - ;; align generic clause - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) - -(defun vhdl-port-paste-port () - "Paste a port clause." - (let ((margin (current-indentation)) - (port-list (nth 2 vhdl-port-list)) - list-margin start names port) - ;; paste port clause - (when port-list - (setq start (point)) - (vhdl-insert-keyword "PORT (") - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while port-list - (setq port (car port-list)) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments '(decl always)) - (vhdl-paste-group-comment (nth 5 port) list-margin)) - ;; paste object - (when (nth 1 port) (insert (nth 1 port) " ")) - ;; paste names - (setq names (nth 0 port)) - (while names - (insert (car names)) - (setq names (cdr names)) - (when names (insert ", "))) - ;; paste direction - (insert " : ") - (when (nth 2 port) (insert (nth 2 port) " ")) - ;; paste type - (insert (nth 3 port)) - (unless (cdr port-list) (insert ")")) - (insert ";") - ;; paste comment - (when (and vhdl-include-port-comments (nth 4 port)) - (vhdl-comment-insert-inline (nth 4 port) t)) - (setq port-list (cdr port-list)) - (when port-list (insert "\n") (indent-to list-margin))) - ;; align port clause - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) - -(defun vhdl-port-paste-declaration (kind &optional no-indent) - "Paste as an entity or component declaration." - (unless no-indent (indent-according-to-mode)) - (let ((margin (current-indentation)) - (name (nth 0 vhdl-port-list))) - (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) - (insert name) - (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) - (vhdl-insert-keyword " IS")) - ;; paste generic and port clause - (when (nth 1 vhdl-port-list) - (insert "\n") - (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) - (insert "\n")) - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-port-paste-generic (eq kind 'component))) - (when (nth 2 vhdl-port-list) - (insert "\n") - (when (and (memq vhdl-insert-empty-lines '(unit all)) - (eq kind 'entity)) - (insert "\n")) - (indent-to (+ margin vhdl-basic-offset))) - (vhdl-port-paste-port) - (insert "\n") - (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) - (insert "\n")) - (indent-to margin) - (vhdl-insert-keyword "END") - (if (eq kind 'entity) - (progn - (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) - (insert " " name)) - (vhdl-insert-keyword " COMPONENT") - (unless (vhdl-standard-p '87) (insert " " name))) - (insert ";"))) - -(defun vhdl-port-paste-entity (&optional no-indent) - "Paste as an entity declaration." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) - (vhdl-port-paste-declaration 'entity no-indent) - (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) - -(defun vhdl-port-paste-component (&optional no-indent) - "Paste as a component declaration." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) - (vhdl-port-paste-declaration 'component no-indent) - (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) - -(defun vhdl-port-paste-generic-map (&optional secondary no-constants) - "Paste as a generic map." - (interactive) - (unless secondary (indent-according-to-mode)) - (let ((margin (current-indentation)) - list-margin start generic - (generic-list (nth 1 vhdl-port-list))) - (when generic-list - (setq start (point)) - (vhdl-insert-keyword "GENERIC MAP (") - (if (not vhdl-association-list-with-formals) - ;; paste list of actual generics - (while generic-list - (insert (if no-constants - (car (nth 0 (car generic-list))) - (or (nth 2 (car generic-list)) " "))) - (setq generic-list (cdr generic-list)) - (insert (if generic-list ", " ")")) - (when (and (not generic-list) secondary - (null (nth 2 vhdl-port-list))) - (insert ";"))) - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while generic-list - (setq generic (car generic-list)) - ;; paste group comment and spacing - (when (eq vhdl-include-group-comments 'always) - (vhdl-paste-group-comment (nth 4 generic) list-margin)) - ;; paste formal and actual generic - (insert (car (nth 0 generic)) " => " - (if no-constants - (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 "," ")")) - (when (and (not generic-list) secondary - (null (nth 2 vhdl-port-list))) - (insert ";")) - ;; paste comment - (when (or vhdl-include-type-comments - (and vhdl-include-port-comments (nth 3 generic))) - (vhdl-comment-insert-inline - (concat - (when vhdl-include-type-comments - (concat "[" (nth 1 generic) "] ")) - (when vhdl-include-port-comments (nth 3 generic))) t)) - (when generic-list (insert "\n") (indent-to list-margin))) - ;; align generic map - (when vhdl-auto-align - (vhdl-align-region-groups start (point) 1 t)))))) - -(defun vhdl-port-paste-port-map () - "Paste as a port map." - (let ((margin (current-indentation)) - list-margin start port - (port-list (nth 2 vhdl-port-list))) - (when port-list - (setq start (point)) - (vhdl-insert-keyword "PORT MAP (") - (if (not vhdl-association-list-with-formals) - ;; paste list of actual ports - (while port-list - (insert (vhdl-replace-string vhdl-actual-port-name - (car (nth 0 (car port-list))))) - (setq port-list (cdr port-list)) - (insert (if port-list ", " ")"))) - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while port-list - (setq port (car port-list)) - ;; paste group comment and spacing - (when (eq vhdl-include-group-comments 'always) - (vhdl-paste-group-comment (nth 5 port) list-margin)) - ;; paste formal and actual port - (insert (car (nth 0 port)) " => ") - (insert (vhdl-replace-string vhdl-actual-port-name - (car (nth 0 port)))) - (setq port-list (cdr port-list)) - (insert (if port-list "," ");")) - ;; paste comment - (when (or (and vhdl-include-direction-comments (nth 2 port)) - vhdl-include-type-comments - (and vhdl-include-port-comments (nth 4 port))) - (vhdl-comment-insert-inline - (concat - (cond ((and vhdl-include-direction-comments - vhdl-include-type-comments) - (concat "[" (format "%-4s" (concat (nth 2 port) " ")) - (nth 3 port) "] ")) - ((and vhdl-include-direction-comments (nth 2 port)) - (format "%-6s" (concat "[" (nth 2 port) "] "))) - (vhdl-include-direction-comments " ") - (vhdl-include-type-comments - (concat "[" (nth 3 port) "] "))) - (when vhdl-include-port-comments (nth 4 port))) t)) - (when port-list (insert "\n") (indent-to list-margin))) - ;; align port clause - (when vhdl-auto-align - (vhdl-align-region-groups start (point) 1)))))) - -(defun vhdl-port-paste-instance (&optional name no-indent title) - "Paste as an instantiation." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (let ((orig-vhdl-port-list vhdl-port-list)) - ;; flatten local copy of port list (must be flat for port mapping) - (vhdl-port-flatten) - (unless no-indent (indent-according-to-mode)) - (let ((margin (current-indentation))) - ;; paste instantiation - (cond (name - (insert name)) - ((equal (cdr vhdl-instance-name) "") - (setq name (vhdl-template-field "instance name"))) - ((string-match "%d" (cdr vhdl-instance-name)) - (let ((n 1)) - (while (save-excursion - (setq name (format (vhdl-replace-string - vhdl-instance-name - (nth 0 vhdl-port-list)) n)) - (goto-char (point-min)) - (vhdl-re-search-forward name nil t)) - (setq n (1+ n))) - (insert name))) - (t (insert (vhdl-replace-string vhdl-instance-name - (nth 0 vhdl-port-list))))) - (message "Pasting port as instantiation \"%s\"..." name) - (insert ": ") - (when title - (save-excursion - (beginning-of-line) - (indent-to vhdl-basic-offset) - (insert "-- instance \"" name "\"\n"))) - (if (not (vhdl-use-direct-instantiation)) - (insert (nth 0 vhdl-port-list)) - (vhdl-insert-keyword "ENTITY ") - (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) - (when (nth 1 vhdl-port-list) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (vhdl-port-paste-generic-map t t)) - (when (nth 2 vhdl-port-list) - (insert "\n") (indent-to (+ margin vhdl-basic-offset)) - (vhdl-port-paste-port-map)) - (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) - (insert ";")) - (message "Pasting port as instantiation \"%s\"...done" name)) - (setq vhdl-port-list orig-vhdl-port-list)))) - -(defun vhdl-port-paste-constants (&optional no-indent) - "Paste generics as constants." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (let ((orig-vhdl-port-list vhdl-port-list)) - (message "Pasting port as constants...") - ;; flatten local copy of port list (must be flat for constant initial.) - (vhdl-port-flatten) - (unless no-indent (indent-according-to-mode)) - (let ((margin (current-indentation)) - start generic name - (generic-list (nth 1 vhdl-port-list))) - (when generic-list - (setq start (point)) - (while generic-list - (setq generic (car generic-list)) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments '(decl always)) - (vhdl-paste-group-comment (nth 4 generic) margin)) - (vhdl-insert-keyword "CONSTANT ") - ;; paste generic constants - (setq name (nth 0 generic)) - (when name - (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) - ;; paste type - (insert " : " (nth 1 generic)) - ;; paste initialization - (when (nth 2 generic) - (insert " := " (nth 2 generic))) - (insert ";") - ;; paste comment - (when (and vhdl-include-port-comments (nth 3 generic)) - (vhdl-comment-insert-inline (nth 3 generic) t)) - (setq generic-list (cdr generic-list)) - (when generic-list (insert "\n") (indent-to margin)))) - ;; align signal list - (when vhdl-auto-align - (vhdl-align-region-groups start (point) 1)))) - (message "Pasting port as constants...done") - (setq vhdl-port-list orig-vhdl-port-list)))) - -(defun vhdl-port-paste-signals (&optional initialize no-indent) - "Paste ports as internal signals." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (message "Pasting port as signals...") - (unless no-indent (indent-according-to-mode)) - (let ((margin (current-indentation)) - start port names type generic-list port-name constant-name pos - (port-list (nth 2 vhdl-port-list))) - (when port-list - (setq start (point)) - (while port-list - (setq port (car port-list)) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments '(decl always)) - (vhdl-paste-group-comment (nth 5 port) margin)) - ;; paste object - (if (nth 1 port) - (insert (nth 1 port) " ") - (vhdl-insert-keyword "SIGNAL ")) - ;; paste actual port signals - (setq names (nth 0 port)) - (while names - (insert (vhdl-replace-string vhdl-actual-port-name (car names))) - (setq names (cdr names)) - (when names (insert ", "))) - ;; paste type - (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 " := " - (cond ((string-match "integer" (nth 3 port)) "0") - ((string-match "natural" (nth 3 port)) "0") - ((string-match "positive" (nth 3 port)) "0") - ((string-match "real" (nth 3 port)) "0.0") - ((string-match "(.+)" (nth 3 port)) "(others => '0')") - (t "'0'")))) - (insert ";") - ;; paste comment - (when (or (and vhdl-include-direction-comments (nth 2 port)) - (and vhdl-include-port-comments (nth 4 port))) - (vhdl-comment-insert-inline - (concat - (cond ((and vhdl-include-direction-comments (nth 2 port)) - (format "%-6s" (concat "[" (nth 2 port) "] "))) - (vhdl-include-direction-comments " ")) - (when vhdl-include-port-comments (nth 4 port))) - t)) - (setq port-list (cdr port-list)) - (when port-list (insert "\n") (indent-to margin))) - ;; align signal list - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) - (message "Pasting port as signals...done"))) - -(defun vhdl-port-paste-initializations (&optional no-indent) - "Paste ports as signal initializations." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (let ((orig-vhdl-port-list vhdl-port-list)) - (message "Pasting port as initializations...") - ;; flatten local copy of port list (must be flat for signal initial.) - (vhdl-port-flatten) - (unless no-indent (indent-according-to-mode)) - (let ((margin (current-indentation)) - start port name - (port-list (nth 2 vhdl-port-list))) - (when port-list - (setq start (point)) - (while port-list - (setq port (car port-list)) - ;; paste actual port signal (inputs only) - (when (equal "IN" (upcase (nth 2 port))) - (setq name (car (nth 0 port))) - (insert (vhdl-replace-string vhdl-actual-port-name name)) - ;; paste initialization - (insert " <= " - (cond ((string-match "integer" (nth 3 port)) "0") - ((string-match "natural" (nth 3 port)) "0") - ((string-match "positive" (nth 3 port)) "0") - ((string-match "real" (nth 3 port)) "0.0") - ((string-match "(.+)" (nth 3 port)) "(others => '0')") - (t "'0'")) - ";")) - (setq port-list (cdr port-list)) - (when (and port-list - (equal "IN" (upcase (nth 2 (car port-list))))) - (insert "\n") (indent-to margin))) - ;; align signal list - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) - (message "Pasting port as initializations...done") - (setq vhdl-port-list orig-vhdl-port-list)))) - -(defun vhdl-port-paste-testbench () - "Paste as a bare-bones testbench." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port read") - (let ((case-fold-search t) - (ent-name (vhdl-replace-string vhdl-testbench-entity-name - (nth 0 vhdl-port-list))) - ;; (source-buffer (current-buffer)) - arch-name config-name ent-file-name arch-file-name - ent-buffer arch-buffer position) - ;; open entity file - (unless (eq vhdl-testbench-create-files 'none) - (setq ent-file-name - (concat (vhdl-replace-string vhdl-testbench-entity-file-name - ent-name t) - "." (file-name-extension (buffer-file-name)))) - (if (file-exists-p ent-file-name) - (if (y-or-n-p - (concat "File \"" ent-file-name "\" exists; overwrite? ")) - (progn (find-file ent-file-name) - (erase-buffer) - (set-buffer-modified-p nil)) - (if (eq vhdl-testbench-create-files 'separate) - (setq ent-file-name nil) - (error "ERROR: Pasting port as testbench...aborted"))) - (find-file ent-file-name))) - (unless (and (eq vhdl-testbench-create-files 'separate) - (null ent-file-name)) - ;; paste entity header - (if vhdl-testbench-include-header - (progn (vhdl-template-header - (concat "Testbench for design \"" - (nth 0 vhdl-port-list) "\"")) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n")) - ;; paste std_logic_1164 package - (when vhdl-testbench-include-library - (vhdl-template-package-std-logic-1164) - (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) - ;; paste entity declaration - (vhdl-insert-keyword "ENTITY ") - (insert ent-name) - (vhdl-insert-keyword " IS") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (insert "\n") - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) - (insert ent-name ";") - (insert "\n\n") - (vhdl-comment-display-line) (insert "\n")) - ;; get architecture name - (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") - (read-from-minibuffer "architecture name: " - nil vhdl-minibuffer-local-map) - (vhdl-replace-string vhdl-testbench-architecture-name - (nth 0 vhdl-port-list)))) - (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) - ;; open architecture file - (if (not (eq vhdl-testbench-create-files 'separate)) - (insert "\n") - (setq ent-buffer (current-buffer)) - (setq arch-file-name - (concat (vhdl-replace-string vhdl-testbench-architecture-file-name - (concat ent-name " " arch-name) t) - "." (file-name-extension (buffer-file-name)))) - (when (and (file-exists-p arch-file-name) - (not (y-or-n-p (concat "File \"" arch-file-name - "\" exists; overwrite? ")))) - (error "ERROR: Pasting port as testbench...aborted")) - (find-file arch-file-name) - (erase-buffer) - (set-buffer-modified-p nil) - ;; paste architecture header - (if vhdl-testbench-include-header - (progn (vhdl-template-header - (concat "Testbench architecture for design \"" - (nth 0 vhdl-port-list) "\"")) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n"))) - ;; paste architecture body - (vhdl-insert-keyword "ARCHITECTURE ") - (insert arch-name) - (vhdl-insert-keyword " OF ") - (insert ent-name) - (vhdl-insert-keyword " IS") - (insert "\n\n") (indent-to vhdl-basic-offset) - ;; paste component declaration - (unless (vhdl-use-direct-instantiation) - (vhdl-port-paste-component t) - (insert "\n\n") (indent-to vhdl-basic-offset)) - ;; paste constants - (when (nth 1 vhdl-port-list) - (insert "-- component generics\n") (indent-to vhdl-basic-offset) - (vhdl-port-paste-constants t) - (insert "\n\n") (indent-to vhdl-basic-offset)) - ;; paste internal signals - (insert "-- component ports\n") (indent-to vhdl-basic-offset) - (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) - (insert "\n") - ;; paste custom declarations - (unless (equal "" vhdl-testbench-declarations) - (insert "\n") - (setq position (point)) - (vhdl-insert-string-or-file vhdl-testbench-declarations) - (indent-region position (point))) - (setq position (point)) - (insert "\n\n") - (vhdl-comment-display-line) (insert "\n") - (when vhdl-testbench-include-configuration - (setq config-name (vhdl-replace-string - vhdl-testbench-configuration-name - (concat ent-name " " arch-name))) - (insert "\n") - (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) - (vhdl-insert-keyword " OF ") (insert ent-name) - (vhdl-insert-keyword " IS\n") - (indent-to vhdl-basic-offset) - (vhdl-insert-keyword "FOR ") (insert arch-name "\n") - (indent-to vhdl-basic-offset) - (vhdl-insert-keyword "END FOR;\n") - (vhdl-insert-keyword "END ") (insert config-name ";\n\n") - (vhdl-comment-display-line) (insert "\n")) - (goto-char position) - (vhdl-template-begin-end - (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) - ;; paste instantiation - (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) - (vhdl-port-paste-instance - (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) - (insert "\n") - ;; paste custom statements - (unless (equal "" vhdl-testbench-statements) - (insert "\n") - (setq position (point)) - (vhdl-insert-string-or-file vhdl-testbench-statements) - (indent-region position (point))) - (insert "\n") - (indent-to vhdl-basic-offset) - (unless (eq vhdl-testbench-create-files 'none) - (setq arch-buffer (current-buffer)) - (when ent-buffer (set-buffer ent-buffer) (save-buffer)) - (set-buffer arch-buffer) (save-buffer)) - (message "%s" - (concat (format "Pasting port as testbench \"%s(%s)\"...done" - ent-name arch-name) - (and ent-file-name - (format "\n File created: \"%s\"" ent-file-name)) - (and arch-file-name - (format "\n File created: \"%s\"" arch-file-name))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Subprogram interface translation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar vhdl-subprog-list nil - "Variable to hold last subprogram interface parsed.") -;; structure: (parenthesized expression means list of such entries) -;; (subprog-name kind -;; ((names) object direct type init comment group-comment) -;; return-type return-comment group-comment) - -(defvar vhdl-subprog-flattened nil - "Indicates whether an subprogram interface has been flattened.") - -(defun vhdl-subprog-flatten () - "Flatten interface list so that only one parameter exists per line." - (interactive) - (if (not vhdl-subprog-list) - (error "ERROR: No subprogram interface has been read") - (message "Flattening subprogram interface...") - (let ((old-subprog-list (nth 2 vhdl-subprog-list)) - new-subprog-list old-subprog new-subprog names) - ;; traverse parameter list and flatten entries - (while old-subprog-list - (setq old-subprog (car old-subprog-list)) - (setq names (car old-subprog)) - (while names - (setq new-subprog (cons (list (car names)) (cdr old-subprog))) - (setq new-subprog-list (append new-subprog-list (list new-subprog))) - (setq names (cdr names))) - (setq old-subprog-list (cdr old-subprog-list))) - (setq vhdl-subprog-list - (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) - new-subprog-list (nth 3 vhdl-subprog-list) - (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) - vhdl-subprog-flattened t) - (message "Flattening subprogram interface...done")))) - -(defun vhdl-subprog-copy () - "Get interface information from a subprogram specification." - (interactive) - (save-excursion - (let (parse-error pos end-of-list - name kind param-list object names direct type init - comment group-comment - return-type return-comment return-group-comment) - (vhdl-prepare-search-2 - (setq - parse-error - (catch 'parse - ;; check if within function declaration - (setq pos (point)) - (end-of-line) - (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) - (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) - (goto-char (match-end 0)) - (save-excursion (backward-char) - (forward-sexp) - (<= pos (point)))) - (throw 'parse "ERROR: Not within a subprogram specification")) - (setq name (match-string-no-properties 5)) - (setq kind (if (match-string 2) 'procedure 'function)) - (setq end-of-list (not (match-string 7))) - (message "Reading interface of subprogram \"%s\"..." name) - ;; parse parameter list - (setq group-comment (vhdl-parse-group-comment)) - (setq end-of-list (or end-of-list - (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) - (while (not end-of-list) - ;; parse object - (setq object - (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t) - (match-string-no-properties 1))) - ;; parse names (accept extended identifiers) - (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") - (setq names (list (match-string-no-properties 1))) - (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) - (setq names (append names (list (match-string-no-properties 1))))) - ;; parse direction - (vhdl-parse-string ":[ \t\n\r\f]*") - (setq direct - (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t) - (match-string-no-properties 1))) - ;; parse type - (vhdl-parse-string "\\([^():;\n]+\\)") - (setq type (match-string-no-properties 1)) - (setq comment nil) - (while (looking-at "(") - (setq type - (concat type - (buffer-substring-no-properties - (point) (progn (forward-sexp) (point))) - (and (vhdl-parse-string "\\([^():;\n]*\\)" t) - (match-string-no-properties 1))))) - ;; special case: closing parenthesis is on separate line - (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) - (setq comment (substring type (match-beginning 2))) - (setq type (substring type 0 (match-beginning 1)))) - ;; strip off trailing group-comment - (when (string-match "\\S-\\s-*\\'" type) - (setq type (substring type 0 (1+ (match-beginning 0))))) - ;; parse initialization expression - (setq init nil) - (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) - (vhdl-parse-string "\\([^();\n]*\\)") - (setq init (match-string-no-properties 1)) - (while (looking-at "(") - (setq init - (concat init - (buffer-substring-no-properties - (point) (progn (forward-sexp) (point))) - (and (vhdl-parse-string "\\([^();\n]*\\)" t) - (match-string-no-properties 1)))))) - ;; special case: closing parenthesis is on separate line - (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) - (setq comment (substring init (match-beginning 2))) - (setq init (substring init 0 (match-beginning 1))) - (vhdl-forward-syntactic-ws)) - (skip-chars-forward " \t") - ;; parse inline comment, special case: as above, no initial. - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - (vhdl-forward-syntactic-ws) - (setq end-of-list (vhdl-parse-string ")\\s-*" t)) - ;; parse inline comment - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - (setq return-group-comment (vhdl-parse-group-comment)) - (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") - ;; parse return type - (when (match-string 3) - (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*") - (setq return-type (match-string-no-properties 1)) - (when (and return-type - (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) - (setq return-comment (substring return-type (match-beginning 2))) - (setq return-type (substring return-type 0 (match-beginning 1)))) - ;; strip of trailing group-comment - (when (string-match "\\S-\\s-*\\'" return-type) - (setq return-type - (substring return-type 0 (1+ (match-beginning 0))))) - ;; parse return comment - (unless return-comment - (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1))))) - ;; parse inline comment - (unless comment - (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) - (match-string-no-properties 1)))) - ;; save everything in list - (setq param-list (append param-list - (list (list names object direct type init - comment group-comment)))) - ;; parse group comment and spacing - (setq group-comment (vhdl-parse-group-comment))) - (message "Reading interface of subprogram \"%s\"...done" name) - nil))) - ;; finish parsing - (if parse-error - (error parse-error) - (setq vhdl-subprog-list - (list name kind param-list return-type return-comment - return-group-comment) - vhdl-subprog-flattened nil))))) - -(defun vhdl-subprog-paste-specification (kind) - "Paste as a subprogram specification." - (indent-according-to-mode) - (let ((margin (current-column)) - (param-list (nth 2 vhdl-subprog-list)) - list-margin start names param) - ;; paste keyword and name - (vhdl-insert-keyword - (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) - (insert (nth 0 vhdl-subprog-list)) - (if (not param-list) - (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) - (setq start (point)) - ;; paste parameter list - (insert " (") - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while param-list - (setq param (car param-list)) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments (list kind 'always)) - (vhdl-paste-group-comment (nth 6 param) list-margin)) - ;; paste object - (when (nth 1 param) (insert (nth 1 param) " ")) - ;; paste names - (setq names (nth 0 param)) - (while names - (insert (car names)) - (setq names (cdr names)) - (when names (insert ", "))) - ;; paste direction - (insert " : ") - (when (nth 2 param) (insert (nth 2 param) " ")) - ;; paste type - (insert (nth 3 param)) - ;; paste initialization - (when (nth 4 param) (insert " := " (nth 4 param))) - ;; terminate line - (if (cdr param-list) - (insert ";") - (insert ")") - (when (null (nth 3 vhdl-subprog-list)) - (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) - ;; paste comment - (when (and vhdl-include-port-comments (nth 5 param)) - (vhdl-comment-insert-inline (nth 5 param) t)) - (setq param-list (cdr param-list)) - (when param-list (insert "\n") (indent-to list-margin))) - (when (nth 3 vhdl-subprog-list) - (insert "\n") (indent-to list-margin) - ;; paste group comment and spacing - (when (memq vhdl-include-group-comments (list kind 'always)) - (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) - ;; paste return type - (insert "return " (nth 3 vhdl-subprog-list)) - (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) - (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) - (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) - ;; align parameter list - (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) - ;; paste body - (when (eq kind 'body) - (insert "\n") - (vhdl-template-begin-end - (unless (vhdl-standard-p '87) - (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) - (nth 0 vhdl-subprog-list) margin)))) - -(defun vhdl-subprog-paste-declaration () - "Paste as a subprogram declaration." - (interactive) - (if (not vhdl-subprog-list) - (error "ERROR: No subprogram interface read") - (message "Pasting interface as subprogram declaration \"%s\"..." - (car vhdl-subprog-list)) - ;; paste specification - (vhdl-subprog-paste-specification 'decl) - (message "Pasting interface as subprogram declaration \"%s\"...done" - (car vhdl-subprog-list)))) - -(defun vhdl-subprog-paste-body () - "Paste as a subprogram body." - (interactive) - (if (not vhdl-subprog-list) - (error "ERROR: No subprogram interface read") - (message "Pasting interface as subprogram body \"%s\"..." - (car vhdl-subprog-list)) - ;; paste specification and body - (vhdl-subprog-paste-specification 'body) - (message "Pasting interface as subprogram body \"%s\"...done" - (car vhdl-subprog-list)))) - -(defun vhdl-subprog-paste-call () - "Paste as a subprogram call." - (interactive) - (if (not vhdl-subprog-list) - (error "ERROR: No subprogram interface read") - (let ((orig-vhdl-subprog-list vhdl-subprog-list) - param-list margin list-margin param start) - ;; flatten local copy of interface list (must be flat for parameter mapping) - (vhdl-subprog-flatten) - (setq param-list (nth 2 vhdl-subprog-list)) - (indent-according-to-mode) - (setq margin (current-indentation)) - (message "Pasting interface as subprogram call \"%s\"..." - (car vhdl-subprog-list)) - ;; paste name - (insert (nth 0 vhdl-subprog-list)) - (if (not param-list) - (insert ";") - (setq start (point)) - ;; paste parameter list - (insert " (") - (unless vhdl-argument-list-indent - (insert "\n") (indent-to (+ margin vhdl-basic-offset))) - (setq list-margin (current-column)) - (while param-list - (setq param (car param-list)) - ;; paste group comment and spacing - (when (eq vhdl-include-group-comments 'always) - (vhdl-paste-group-comment (nth 6 param) list-margin)) - ;; paste formal port - (insert (car (nth 0 param)) " => ") - (setq param-list (cdr param-list)) - (insert (if param-list "," ");")) - ;; paste comment - (when (and vhdl-include-port-comments (nth 5 param)) - (vhdl-comment-insert-inline (nth 5 param))) - (when param-list (insert "\n") (indent-to list-margin))) - ;; align parameter list - (when vhdl-auto-align - (vhdl-align-region-groups start (point) 1))) - (message "Pasting interface as subprogram call \"%s\"...done" - (car vhdl-subprog-list)) - (setq vhdl-subprog-list orig-vhdl-subprog-list)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Hippie expand customization - -(defvar vhdl-expand-upper-case nil) - -(defun vhdl-try-expand-abbrev (old) - "Try expanding abbreviations from `vhdl-abbrev-list'." - (unless old - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (let ((abbrev-list vhdl-abbrev-list) - (sel-abbrev-list '())) - (while abbrev-list - (when (or (not (stringp (car abbrev-list))) - (string-match - (concat "^" he-search-string) (car abbrev-list))) - (setq sel-abbrev-list - (cons (car abbrev-list) sel-abbrev-list))) - (setq abbrev-list (cdr abbrev-list))) - (nreverse sel-abbrev-list)))) - (while (and he-expand-list - (or (not (stringp (car he-expand-list))) - (he-string-member (car he-expand-list) he-tried-table t))) - (unless (stringp (car he-expand-list)) - (setq vhdl-expand-upper-case (car he-expand-list))) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn (when old (he-reset-string)) - nil) - (he-substitute-string - (if vhdl-expand-upper-case - (upcase (car he-expand-list)) - (car he-expand-list)) - t) - (setq he-expand-list (cdr he-expand-list)) - t)) - -(defun vhdl-he-list-beg () - "Also looks at the word before `(' in order to better match parenthesized -expressions (e.g. for index ranges of types and signals)." - (save-excursion - (condition-case () - (progn (backward-up-list 1) - (skip-syntax-backward "w_")) ; crashes in `viper-mode' - (error ())) - (point))) - -;; override `he-list-beg' from `hippie-exp' -(unless (and (boundp 'viper-mode) viper-mode) - (defalias 'he-list-beg #'vhdl-he-list-beg)) - -;; function for expanding abbrevs and dabbrevs -(defalias 'vhdl-expand-abbrev (make-hippie-expand-function - '(try-expand-dabbrev - try-expand-dabbrev-all-buffers - vhdl-try-expand-abbrev))) - -;; function for expanding parenthesis -(defalias 'vhdl-expand-paren (make-hippie-expand-function - '(try-expand-list - try-expand-list-all-buffers))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Line handling functions - -(defun vhdl-current-line () - "Return the line number of the line containing point." - (save-restriction - (widen) - (1+ (count-lines (point-min) (line-beginning-position))))) - -(defun vhdl-line-kill-entire (&optional arg) - "Delete entire line." - (interactive "p") - (beginning-of-line) - (kill-line (or arg 1))) - -(defun vhdl-line-kill (&optional arg) - "Kill current line." - (interactive "p") - (vhdl-line-kill-entire arg)) - -(defun vhdl-line-copy (&optional arg) - "Copy current line." - (interactive "p") - (save-excursion - (let ((position (line-beginning-position))) - (forward-line (or arg 1)) - (copy-region-as-kill position (point))))) - -(defun vhdl-line-yank () - "Yank entire line." - (interactive) - (beginning-of-line) - (yank)) - -(defun vhdl-line-expand (&optional 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))) - (hippie-expand arg))) - -(defun vhdl-line-transpose-next (&optional arg) - "Interchange this line with next line." - (interactive "p") - (forward-line 1) - (transpose-lines (or arg 1)) - (forward-line -1)) - -(defun vhdl-line-transpose-previous (&optional arg) - "Interchange this line with previous line." - (interactive "p") - (forward-line 1) - (transpose-lines (- 0 (or arg 0))) - (forward-line -1)) - -(defun vhdl-line-open () - "Open a new line and indent." - (interactive) - (end-of-line -0) - (newline-and-indent)) - -(defun vhdl-delete-indentation () - "Join lines. That is, call `delete-indentation' with `fill-prefix' so that -it works within comments too." - (interactive) - (let ((fill-prefix "-- ")) - (delete-indentation))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Move functions - -(defun vhdl-forward-same-indent () - "Move forward to next line with same indent." - (interactive) - (let ((pos (point)) - (indent (current-indentation))) - (beginning-of-line 2) - (while (and (not (eobp)) - (or (looking-at "^\\s-*\\(--.*\\)?$") - (> (current-indentation) indent))) - (beginning-of-line 2)) - (if (= (current-indentation) indent) - (back-to-indentation) - (message "No following line with same indent found in this block") - (goto-char pos) - nil))) - -(defun vhdl-backward-same-indent () - "Move backward to previous line with same indent." - (interactive) - (let ((pos (point)) - (indent (current-indentation))) - (beginning-of-line -0) - (while (and (not (bobp)) - (or (looking-at "^\\s-*\\(--.*\\)?$") - (> (current-indentation) indent))) - (beginning-of-line -0)) - (if (= (current-indentation) indent) - (back-to-indentation) - (message "No preceding line with same indent found in this block") - (goto-char pos) - nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Statistics - -(defun vhdl-statistics-buffer () - "Get some file statistics." - (interactive) - (let ((no-stats 0) - (no-code-lines 0) - (no-empty-lines 0) - (no-comm-lines 0) - (no-comments 0) - (no-lines (count-lines (point-min) (point-max)))) - (save-excursion - ;; count statements - (goto-char (point-min)) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) - (if (match-string 1) - (goto-char (match-end 1)) - (setq no-stats (1+ no-stats)))) - ;; count code lines - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "^\\s-*\\(--.*\\)?$") - (setq no-code-lines (1+ no-code-lines))) - (beginning-of-line 2)) - ;; count empty lines - (goto-char (point-min)) - (while (and (re-search-forward "^\\s-*$" nil t) - (not (eq (point) (point-max)))) - (if (match-string 1) - (goto-char (match-end 1)) - (setq no-empty-lines (1+ no-empty-lines)) - (unless (eq (point) (point-max)) - (forward-char)))) - ;; count comment-only lines - (goto-char (point-min)) - (while (re-search-forward "^\\s-*--.*" nil t) - (if (match-string 1) - (goto-char (match-end 1)) - (setq no-comm-lines (1+ no-comm-lines)))) - ;; count comments - (goto-char (point-min)) - (while (re-search-forward "--.*" nil t) - (if (match-string 1) - (goto-char (match-end 1)) - (setq no-comments (1+ no-comments))))) - ;; print results - (message "\n\ -File statistics: \"%s\"\n\ ------------------------\n\ -# statements : %5d\n\ -# code lines : %5d\n\ -# empty lines : %5d\n\ -# comment lines : %5d\n\ -# comments : %5d\n\ -# total lines : %5d\n" - (buffer-file-name) no-stats no-code-lines no-empty-lines - no-comm-lines no-comments no-lines) - (when (featurep 'xemacs) (vhdl-show-messages)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Help functions - -(defun vhdl-re-search-forward (regexp &optional bound noerror count) - "Like `re-search-forward', but does not match within literals." - (let (pos) - (save-excursion - (while (and (setq pos (re-search-forward regexp bound noerror count)) - (save-match-data (vhdl-in-literal))))) - (when pos (goto-char pos)) - pos)) - -(defun vhdl-re-search-backward (regexp &optional bound noerror count) - "Like `re-search-backward', but does not match within literals." - (let (pos) - (save-excursion - (while (and (setq pos (re-search-backward regexp bound noerror count)) - (save-match-data (vhdl-in-literal))))) - (when pos (goto-char pos)) - pos)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Project -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vhdl-set-project (name) - "Set current project to NAME." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Project name: " vhdl-project-alist nil t)))) - (cond ((equal name "") - (setq vhdl-project nil) - (message "Current VHDL project: None")) - ((assoc name vhdl-project-alist) - (setq vhdl-project name) - (message "Current VHDL project: \"%s\"" name)) - (t - (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) - (vhdl-speedbar-update-current-project)) - -(defun vhdl-set-default-project () - "Set current project as default on startup." - (interactive) - (customize-set-variable 'vhdl-project vhdl-project) - (customize-save-customized)) - -(defun vhdl-toggle-project (name _token _indent) - "Set current project to NAME or unset if NAME is current project." - (vhdl-set-project (if (equal name vhdl-project) "" name))) - -(defun vhdl-export-project (file-name) - "Write project setup for current project." - (interactive - (let ((name (vhdl-resolve-env-variable - (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) - (concat (subst-char-in-string - ? ?_ (or (vhdl-project-p) - (error "ERROR: No current project"))) - " " (user-login-name)))))) - (list (read-file-name - "Write project file: " - (when (file-name-absolute-p name) "") nil nil name)))) - (setq file-name (abbreviate-file-name file-name)) - (let ((orig-buffer (current-buffer))) - (unless (file-exists-p (file-name-directory file-name)) - (make-directory (file-name-directory file-name) t)) - (if (not (file-writable-p file-name)) - (error "ERROR: File not writable: \"%s\"" file-name) - (set-buffer (find-file-noselect file-name t t)) - (erase-buffer) - (insert ";; -*- Emacs-Lisp -*-\n\n" - ";;; " (file-name-nondirectory file-name) - " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" - ";; Project : " vhdl-project "\n" - ";; Saved : " (format-time-string "%Y-%m-%d %T ") - (user-login-name) "\n\n\n" - ";; project name\n" - "(setq vhdl-project \"" vhdl-project "\")\n\n" - ";; project setup\n" - "(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)) - (set-buffer orig-buffer)))) - -(defun vhdl-import-project (file-name &optional auto not-make-current) - "Read project setup and set current project." - (interactive - (let ((name (vhdl-resolve-env-variable - (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) - (concat "" " " (user-login-name)))))) - (list (read-file-name - "Read project file: " (when (file-name-absolute-p name) "") nil t - (file-name-directory name))))) - (when (file-exists-p file-name) - (condition-case () - (let ((current-project vhdl-project)) - (load-file file-name) - (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10) - (vhdl-adelete 'vhdl-project-alist vhdl-project) - (error "")) - (if not-make-current - (setq vhdl-project current-project) - (setq vhdl-compiler - (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project))))) - (vhdl-update-mode-menu) - (vhdl-speedbar-refresh) - (unless not-make-current - (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s" - vhdl-project vhdl-compiler (if auto " (auto-loaded)" "")))) - (error (vhdl-warning - (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) - -(defun vhdl-duplicate-project () - "Duplicate setup of current project." - (interactive) - (let ((new-name (read-from-minibuffer "New project name: ")) - (project-entry (vhdl-aget vhdl-project-alist vhdl-project))) - (setq vhdl-project-alist - (append vhdl-project-alist - (list (cons new-name project-entry)))) - (vhdl-update-mode-menu))) - -(defun vhdl-autoload-project () - "Automatically load project setup at startup." - (let ((file-name-list vhdl-project-file-name) - file-list list-length) - (while file-name-list - (setq file-list - (append file-list - (file-expand-wildcards - (vhdl-resolve-env-variable - (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) - (concat "* " (user-login-name))))))) - (setq list-length (or list-length (length file-list))) - (setq file-name-list (cdr file-name-list))) - (while file-list - (vhdl-import-project (expand-file-name (car file-list)) t - (not (> list-length 0))) - (setq list-length (1- list-length)) - (setq file-list (cdr file-list))))) -(define-obsolete-function-alias 'vhdl-auto-load-project - #'vhdl-autoload-project "27.1") - -;; automatically load project setup when idle after startup -(when (memq 'startup vhdl-project-autoload) - (if noninteractive - (vhdl-autoload-project) - (vhdl-run-when-idle .1 nil 'vhdl-autoload-project))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Hideshow -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (using `hideshow.el') - -(defconst vhdl-hs-start-regexp - (concat - "\\(^\\)\\s-*\\(" - ;; generic/port clause - "\\(generic\\|port\\)[ \t\n\r\f]*(\\|" - ;; component - "component\\>\\|" - ;; component instantiation - "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*" - "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" - "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*" - "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|" - ;; subprogram - "\\(function\\|procedure\\)\\>\\|" - ;; process, block - "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|" - ;; configuration declaration - "configuration\\>" - "\\)") - "Regexp to match start of construct to hide.") - -(defun vhdl-hs-forward-sexp-func (count) - "Find end of construct to hide (for hideshow). Only search forward." - (let ((pos (point))) - (vhdl-prepare-search-2 - (beginning-of-line) - (cond - ;; generic/port clause - ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(") - (goto-char (match-end 0)) - (backward-char) - (forward-sexp)) - ;; component declaration - ((looking-at "^\\s-*component\\>") - (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) - ;; component instantiation - ((looking-at - (concat - "^\\s-*\\w+\\s-*:[ \t\n\r\f]*" - "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" - "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*" - "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*(")) - (goto-char (match-end 0)) - (backward-char) - (forward-sexp) - (setq pos (point)) - (vhdl-forward-syntactic-ws) - (when (looking-at "port\\s-+map[ \t\n\r\f]*(") - (goto-char (match-end 0)) - (backward-char) - (forward-sexp) - (setq pos (point))) - (goto-char pos)) - ;; subprogram declaration/body - ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") - (goto-char (match-end 0)) - (vhdl-forward-syntactic-ws) - (when (looking-at "(") - (forward-sexp)) - (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) - (vhdl-in-literal))) - ;; subprogram body - (when (match-string 2) - (re-search-forward "^\\s-*\\<begin\\>" nil t) - (backward-word-strictly 1) - (vhdl-forward-sexp))) - ;; block (recursive) - ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") - (goto-char (match-end 0)) - (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) - (match-beginning 2)) - (vhdl-hs-forward-sexp-func count))) - ;; process - ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") - (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) - ;; configuration declaration - ((looking-at "^\\s-*configuration\\>") - (forward-word-strictly 4) - (vhdl-forward-sexp)) - (t (goto-char pos)))))) - -(defun vhdl-hideshow-init () - "Initialize `hideshow'." - (when vhdl-hideshow-menu - (vhdl-hs-minor-mode 1))) - -(defun vhdl-hs-minor-mode (&optional arg) - "Toggle hideshow minor mode and update menu bar." - (interactive "P") - (require 'hideshow) - (declare-function hs-hide-all "hideshow" ()) - ;; check for hideshow version 5.x - (if (not (boundp 'hs-block-start-mdata-select)) - (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") - ;; initialize hideshow - (unless (assoc 'vhdl-mode hs-special-modes-alist) - (setq hs-special-modes-alist - (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" - 'vhdl-hs-forward-sexp-func nil) - hs-special-modes-alist))) - (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) - (if vhdl-hide-all-init - (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t) - (remove-hook 'hs-minor-mode-hook #'hs-hide-all t)) - (hs-minor-mode arg) - (force-mode-line-update))) ; hack to update menu bar - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Font locking -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (using `font-lock.el') - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Help functions - -(defun vhdl-within-translate-off () - "Return point if within translate-off region, else nil." - (and (save-excursion - (re-search-backward - "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) - (equal "off" (match-string 1)) - (point))) - -(defun vhdl-start-translate-off (limit) - "Return point before translate-off pragma if before LIMIT, else nil." - (when (re-search-forward - "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) - (match-beginning 0))) - -(defun vhdl-end-translate-off (limit) - "Return point after translate-on pragma if before LIMIT, else nil." - (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) - -(defun vhdl-match-translate-off (limit) - "Match a translate-off block, setting match-data and returning t, else nil." - (when (< (point) limit) - (let ((start (or (vhdl-within-translate-off) - (vhdl-start-translate-off limit))) - (case-fold-search t)) - (when start - (let ((end (or (vhdl-end-translate-off limit) limit))) - (set-match-data (list start end)) - (goto-char end)))))) - -(defun vhdl-font-lock-match-item (limit) - "Match, and move over, any declaration item after point. -Adapted from -`font-lock-match-c-style-declaration-item-and-skip-to-next'." - (condition-case nil - (save-restriction - (narrow-to-region (point-min) limit) - ;; match item - (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") - (save-match-data - (goto-char (match-end 1)) - ;; move to next item - (if (looking-at "\\(\\s-*,\\)") - (goto-char (match-end 1)) - (end-of-line) t)))) - (error t))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Syntax definitions - -(defconst vhdl-font-lock-syntactic-keywords - '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\')))) - "Mark single quotes as having string quote syntax in `c' instances.") - -(defvar vhdl-font-lock-keywords nil - "Regular expressions to highlight in VHDL Mode.") - -(defvar vhdl-font-lock-keywords-0 nil - ;; set in `vhdl-font-lock-init' because dependent on user options - "For consideration as a value of `vhdl-font-lock-keywords'. -This does highlighting of template prompts and directives (pragmas).") - -(defvar vhdl-font-lock-keywords-1 nil - ;; set in `vhdl-font-lock-init' because dependent on user options - "For consideration as a value of `vhdl-font-lock-keywords'. -This does highlighting of keywords and standard identifiers.") - -(defconst vhdl-font-lock-keywords-2 - (list - ;; highlight names of units, subprograms, and components when declared - (list - (concat - "^\\s-*\\(" - "architecture\\|configuration\\|context\\|entity\\|package" - "\\(\\s-+body\\)?\\|" - "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" - "\\)\\s-+\\(\\w+\\)") - 5 'font-lock-function-name-face) - - ;; highlight entity names of architectures and configurations - (list - "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" - 2 'font-lock-function-name-face) - - ;; highlight labels of common constructs - (list - (concat - "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\(" - "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" - "postponed\\|process\\|" - (when (vhdl-standard-p 'ams) "procedural\\|") - "with\\|while" - "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") - 1 'font-lock-function-name-face) - - ;; highlight label and component name of component instantiations - (list - (concat - "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*" - "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>") - '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) - - ;; highlight label and instantiated unit of component instantiations - (list - (concat - "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*" - "\\(component\\|configuration\\|entity\\)\\s-+" - "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") - '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) - '(5 font-lock-function-name-face nil t) - '(7 font-lock-function-name-face nil t)) - - ;; highlight names and labels at end of constructs - (list - (concat - "^\\s-*end\\s-+\\(\\(" - "architecture\\|block\\|case\\|component\\|configuration\\|context\\|" - "entity\\|for\\|function\\|generate\\|if\\|loop\\|package" - "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|" - (when (vhdl-standard-p 'ams) "procedural\\|") - "units" - "\\)\\s-+\\)?\\(\\w*\\)") - 5 'font-lock-function-name-face) - - ;; highlight labels in exit and next statements - (list - (concat - "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") - 3 'font-lock-function-name-face) - - ;; highlight entity name in attribute specifications - (list - (concat - "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") - 1 'font-lock-function-name-face) - - ;; highlight labels in block and component specifications - (list - (concat - "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" - "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)") - '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) - - ;; highlight names in library clauses - (list "^\\s-*library\\>" - '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) - - ;; highlight names in use clauses - (list - (concat - "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" - "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") - '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t) - '(8 font-lock-function-name-face nil t)) - - ;; highlight attribute name in attribute declarations/specifications - (list - (concat - "^\\s-*attribute\\s-+\\(\\w+\\)") - 1 'vhdl-font-lock-attribute-face) - - ;; highlight type/nature name in (sub)type/(sub)nature declarations - (list - (concat - "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)") - 5 'font-lock-type-face) - - ;; highlight signal/variable/constant declaration names - (list "\\(:[^=]\\)" - '(vhdl-font-lock-match-item - (progn (goto-char (match-beginning 1)) - (skip-syntax-backward " ") - (skip-syntax-backward "w_") - (skip-syntax-backward " ") - (while (= (preceding-char) ?,) - (backward-char 1) - (skip-syntax-backward " ") - (skip-syntax-backward "w_") - (skip-syntax-backward " "))) - (goto-char (match-end 1)) (1 font-lock-variable-name-face))) - - ;; highlight formal parameters in component instantiations and subprogram - ;; calls - (list "\\(=>\\)" - '(vhdl-font-lock-match-item - (progn (goto-char (match-beginning 1)) - (skip-syntax-backward " ") - (while (= (preceding-char) ?\)) (backward-sexp)) - (skip-syntax-backward "w_") - (skip-syntax-backward " ") - (when (memq (preceding-char) '(?n ?N ?|)) - (goto-char (point-max)))) - (goto-char (match-end 1)) (1 font-lock-variable-name-face))) - - ;; highlight alias/group/quantity declaration names and for-loop/-generate - ;; variables - (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" - '(vhdl-font-lock-match-item - (progn (goto-char (match-end 1)) (match-beginning 2)) - nil (1 font-lock-variable-name-face))) - - ;; highlight tool directives - (list - (concat - "^\\s-*\\(`\\w+\\)") - 1 'font-lock-preprocessor-face) - ) - "For consideration as a value of `vhdl-font-lock-keywords'. -This does context sensitive highlighting of names and labels.") - -(defvar vhdl-font-lock-keywords-3 nil - ;; set in `vhdl-font-lock-init' because dependent on user options - "For consideration as a value of `vhdl-font-lock-keywords'. -This does highlighting of words with special syntax.") - -(defvar vhdl-font-lock-keywords-4 nil - ;; set in `vhdl-font-lock-init' because dependent on user options - "For consideration as a value of `vhdl-font-lock-keywords'. -This does highlighting of additional reserved words.") - -(defconst vhdl-font-lock-keywords-5 - ;; background highlight translate-off regions - '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) - "For consideration as a value of `vhdl-font-lock-keywords'. -This does background highlighting of translate-off regions.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Font and color definitions - -(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face - "Face name to use for prompts.") - -(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face - "Face name to use for standardized attributes.") - -(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face - "Face name to use for standardized enumeration values.") - -(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face - "Face name to use for standardized functions and packages.") - -(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face - "Face name to use for directives.") - -(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face - "Face name to use for additional reserved words.") - -(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face - "Face name to use for translate-off regions.") - -;; face names to use for words with special syntax. -(let ((syntax-alist vhdl-special-syntax-alist) - name) - (while syntax-alist - (setq name (vhdl-function-name - "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) - ;; FIXME: This `defvar' shouldn't be needed: just quote the face - ;; name when you use it. - (eval `(defvar ,name ',name - ,(concat "Face name to use for " - (nth 0 (car syntax-alist)) "."))) - (setq syntax-alist (cdr syntax-alist)))) - -(defgroup vhdl-highlight-faces nil - "Faces for highlighting." - :group 'vhdl-highlight) - -;; add faces used from `font-lock' -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) -(custom-add-to-group - 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) - -(defface vhdl-font-lock-prompt-face - '((((min-colors 88) (class color) (background light)) - (:foreground "Red1" :bold t)) - (((class color) (background light)) (:foreground "Red" :bold t)) - (((class color) (background dark)) (:foreground "Pink" :bold t)) - (t (:inverse-video t))) - "Font lock mode face used to highlight prompts." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-attribute-face - '((((class color) (background light)) (:foreground "Orchid")) - (((class color) (background dark)) (:foreground "LightSteelBlue")) - (t (:italic t :bold t))) - "Font lock mode face used to highlight standardized attributes." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-enumvalue-face - '((((class color) (background light)) (:foreground "SaddleBrown")) - (((class color) (background dark)) (:foreground "BurlyWood")) - (t (:italic t :bold t))) - "Font lock mode face used to highlight standardized enumeration values." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-function-face - '((((class color) (background light)) (:foreground "Cyan4")) - (((class color) (background dark)) (:foreground "Orchid1")) - (t (:italic t :bold t))) - "Font lock mode face used to highlight standardized functions and packages." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-directive-face - '((((class color) (background light)) (:foreground "CadetBlue")) - (((class color) (background dark)) (:foreground "Aquamarine")) - (t (:italic t :bold t))) - "Font lock mode face used to highlight directives." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-reserved-words-face - '((((class color) (background light)) (:foreground "Orange" :bold t)) - (((min-colors 88) (class color) (background dark)) - (:foreground "Yellow1" :bold t)) - (((class color) (background dark)) (:foreground "Yellow" :bold t)) - (t ())) - "Font lock mode face used to highlight additional reserved words." - :group 'vhdl-highlight-faces) - -(defface vhdl-font-lock-translate-off-face - '((((class color) (background light)) (:background "LightGray")) - (((class color) (background dark)) (:background "DimGray")) - (t ())) - "Font lock mode face used to background highlight translate-off regions." - :group 'vhdl-highlight-faces) - -;; font lock mode faces used to highlight words with special syntax. -(let ((syntax-alist vhdl-special-syntax-alist)) - (while syntax-alist - (eval `(defface ,(vhdl-function-name - "vhdl-font-lock" (caar syntax-alist) "face") - '((((class color) (background light)) - (:foreground ,(nth 2 (car syntax-alist)))) - (((class color) (background dark)) - (:foreground ,(nth 3 (car syntax-alist)))) - (t ())) - ,(concat "Font lock mode face used to highlight " - (nth 0 (car syntax-alist)) ".") - :group 'vhdl-highlight-faces)) - (setq syntax-alist (cdr syntax-alist)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Font lock initialization - -(defun vhdl-font-lock-init () - "Initialize fontification." - ;; highlight template prompts and directives - (setq vhdl-font-lock-keywords-0 - (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" - vhdl-template-prompt-syntax ">\\)") - 2 'vhdl-font-lock-prompt-face t) - (list (concat "--\\s-*" - "\\<" - (regexp-opt vhdl-directive-keywords t) - "\\>" - "\\s-+\\(.*\\)$") - 2 'vhdl-font-lock-directive-face t) - ;; highlight c-preprocessor directives - (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" - '(1 font-lock-builtin-face) - '(3 font-lock-variable-name-face nil t)))) - ;; highlight keywords and standardized types, attributes, enumeration - ;; values, and subprograms - (setq vhdl-font-lock-keywords-1 - (list - (list (concat "'" vhdl-attributes-regexp) - 1 'vhdl-font-lock-attribute-face) - (list vhdl-types-regexp 1 'font-lock-type-face) - (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) - (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) - (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) - (list vhdl-constants-regexp 1 'font-lock-constant-face) - (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) - ;; highlight words with special syntax. - (setq vhdl-font-lock-keywords-3 - (let ((syntax-alist vhdl-special-syntax-alist) - keywords) - (while syntax-alist - (setq keywords - (cons - (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1 - (vhdl-function-name - "vhdl-font-lock" (nth 0 (car syntax-alist)) "face") - (nth 4 (car syntax-alist))) - keywords)) - (setq syntax-alist (cdr syntax-alist))) - keywords)) - ;; highlight additional reserved words - (setq vhdl-font-lock-keywords-4 - (list (list vhdl-reserved-words-regexp 1 - 'vhdl-font-lock-reserved-words-face))) - ;; highlight everything together - (setq vhdl-font-lock-keywords - (append - vhdl-font-lock-keywords-0 - (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) - (when (or vhdl-highlight-forbidden-words - vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) - (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) - (when vhdl-highlight-names vhdl-font-lock-keywords-2) - (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) - -;; initialize fontification for VHDL Mode -(vhdl-font-lock-init) - -(defun vhdl-fontify-buffer () - "Re-initialize fontification and fontify buffer." - (interactive) - (setq font-lock-defaults - `(vhdl-font-lock-keywords - nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) - beginning-of-line)) - (when (fboundp 'font-lock-unset-defaults) - (font-lock-unset-defaults)) ; not implemented in XEmacs - (font-lock-set-defaults) - (font-lock-mode nil) - (font-lock-mode t)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Initialization for PostScript printing - -(defun vhdl-ps-print-settings () - "Initialize custom face and page settings for PostScript printing." - ;; define custom face settings - (unless (or (not vhdl-print-customize-faces) - ps-print-color-p) - (set (make-local-variable 'ps-bold-faces) - '(font-lock-keyword-face - font-lock-type-face - vhdl-font-lock-attribute-face - vhdl-font-lock-enumvalue-face - vhdl-font-lock-directive-face)) - (set (make-local-variable 'ps-italic-faces) - '(font-lock-comment-face - font-lock-function-name-face - font-lock-type-face - vhdl-font-lock-attribute-face - vhdl-font-lock-enumvalue-face - vhdl-font-lock-directive-face)) - (set (make-local-variable 'ps-underlined-faces) - '(font-lock-string-face)) - (setq ps-always-build-face-reference t)) - ;; define page settings, so that a line containing 79 characters (default) - ;; fits into one column - (when vhdl-print-two-column - (set (make-local-variable 'ps-landscape-mode) t) - (set (make-local-variable 'ps-number-of-columns) 2) - (set (make-local-variable 'ps-font-size) 7.0) - (set (make-local-variable 'ps-header-title-font-size) 10.0) - (set (make-local-variable 'ps-header-font-size) 9.0) - (set (make-local-variable 'ps-header-offset) 12.0) - (when (eq ps-paper-type 'letter) - (set (make-local-variable 'ps-inter-column) 40.0) - (set (make-local-variable 'ps-left-margin) 40.0) - (set (make-local-variable 'ps-right-margin) 40.0)))) - -(defun vhdl-ps-print-init () - "Initialize PostScript printing." - (if (featurep 'xemacs) - (when (boundp 'ps-print-color-p) - (vhdl-ps-print-settings)) - (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) - (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Hierarchy browser (using `speedbar.el') -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Allows displaying the hierarchy of all VHDL design units contained in a -;; directory by using the speedbar. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables - -(defvar vhdl-entity-alist nil - "Cache with entities and corresponding architectures for each project/directory.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key -;; (ent-key ent-name ent-file ent-line -;; (arch-key arch-name arch-file arch-line -;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key -;; inst-arch-key inst-conf-key inst-lib-key inst-path) -;; (lib-name pack-key)) -;; mra-key (lib-name pack-key)) - -(defvar vhdl-config-alist nil - "Cache with configurations for each project/directory.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key -;; (conf-key conf-name conf-file conf-line ent-key arch-key -;; (inst-key inst-comp-name inst-ent-key inst-arch-key -;; inst-conf-key inst-lib-key) -;; (lib-name pack-key))) - -(defvar vhdl-package-alist nil - "Cache with packages for each project/directory.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key -;; (pack-key pack-name pack-file pack-line -;; (comp-key comp-name comp-file comp-line) -;; (func-key func-name func-file func-line) -;; (lib-name pack-key) -;; pack-body-file pack-body-line -;; (func-key func-name func-body-file func-body-line) -;; (lib-name pack-key))) - -(defvar vhdl-ent-inst-alist nil - "Cache with instantiated entities for each project/directory.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key (inst-ent-key)) - -(defvar vhdl-file-alist nil - "Cache with design units in each file for each project/directory.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key -;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) -;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) - -(defvar vhdl-directory-alist nil - "Cache with source directories for each project.") -;; structure: (parenthesized expression means list of such entries) -;; (cache-key (directory)) - -(defvar vhdl-speedbar-shown-unit-alist nil - "Alist of design units simultaneously open in the current speedbar for each -directory and project.") - -(defvar vhdl-speedbar-shown-project-list nil - "List of projects simultaneously open in the current speedbar.") - -(defvar vhdl-updated-project-list nil - "List of projects and directories with updated files.") - -(defvar vhdl-modified-file-list nil - "List of modified files to be rescanned for hierarchy updating.") - -(defvar vhdl-speedbar-hierarchy-depth 0 - "Depth of instantiation hierarchy to display.") - -(defvar vhdl-speedbar-show-projects nil - "Non-nil means project hierarchy is displayed in speedbar, directory -hierarchy otherwise.") - -(defun vhdl-get-end-of-unit () - "Return position of end of current unit." - (let ((pos (point))) - (save-excursion - (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1) - (save-excursion - (goto-char (match-beginning 0)) - (vhdl-backward-syntactic-ws) - (and (/= (preceding-char) ?\;) (not (bobp)))))) - (re-search-backward "^[ \t]*end\\>" pos 1) - (point)))) - -(defun vhdl-match-string-downcase (num &optional string) - "Like `match-string-no-properties' with down-casing." - (let ((match (match-string-no-properties num string))) - (and match (downcase match)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Scan functions - -(defun vhdl-scan-context-clause () - "Scan the context clause that precedes a design unit." - (let (lib-alist) - (save-excursion - (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t) - (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) - (equal "USE" (upcase (match-string 1)))) - (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") - (push (cons (match-string-no-properties 1) - (vhdl-match-string-downcase 2)) - 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) - (let* ((dir-name (match-string 1 name)) - (file-pattern (match-string 2 name)) - (is-directory (= 0 (length file-pattern))) - (file-list - (if update - (list name) - (if is-directory - (vhdl-get-source-files t dir-name) - (vhdl-directory-files - dir-name t (wildcard-to-regexp file-pattern))))) - (key (or project dir-name)) - (file-exclude-regexp - (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 (vhdl-aget vhdl-entity-alist key) - conf-alist (vhdl-aget vhdl-config-alist key) - pack-alist (vhdl-aget vhdl-package-alist key) - ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key)) - file-alist (vhdl-aget vhdl-file-alist key))) - (when (and (not is-directory) (null file-list)) - (message "No such file: \"%s\"" name)) - (setq files-exist file-list) - (when file-list - (setq no-files (length file-list)) - (message "Scanning %s %s\"%s\"..." - (if is-directory "directory" "files") (or num-string "") name) - ;; exclude files - (unless (equal file-exclude-regexp "") - (let ((case-fold-search nil) - file-tmp-list) - (while file-list - (unless (string-match file-exclude-regexp (car file-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 file-list - (unless noninteractive - (message "Scanning %s %s\"%s\"... (%2d%%)" - (if is-directory "directory" "files") - (or num-string "") name - (floor (* 100.0 (- no-files (length file-list))) no-files))) - (let ((file-name (abbreviate-file-name (car file-list))) - ent-list arch-list arch-ent-list conf-list - pack-list pack-body-list inst-list inst-ent-list) - ;; scan file - (vhdl-visit-file - file-name nil - (vhdl-prepare-search-2 - (save-excursion - ;; scan for design units - (if (and limit-design-file-size - (< limit-design-file-size (buffer-size))) - (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) - (setq big-files t)) - ;; scan for entities - (goto-char (point-min)) - (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 (vhdl-aget ent-alist ent-key)) - (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)) - (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) - (let* ((arch-name (match-string-no-properties 1)) - (arch-key (downcase arch-name)) - (ent-name (match-string-no-properties 2)) - (ent-key (downcase ent-name)) - (ent-entry (vhdl-aget ent-alist ent-key)) - (arch-alist (nth 3 ent-entry)) - (arch-entry (vhdl-aget arch-alist arch-key)) - (lib-arch-alist (vhdl-scan-context-clause))) - (if arch-entry - (vhdl-warning-when-idle - "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" - arch-name ent-name (nth 1 arch-entry) - (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)) - (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 (vhdl-aget conf-alist conf-key)) - (ent-name (match-string-no-properties 2)) - (ent-key (downcase ent-name)) - (lib-alist (vhdl-scan-context-clause)) - (conf-line (vhdl-current-line)) - (end-of-unit (vhdl-get-end-of-unit)) - arch-key comp-conf-list inst-key-list - inst-comp-key inst-ent-key inst-arch-key - inst-conf-key inst-lib-key) - (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)") - (setq arch-key (vhdl-match-string-downcase 1))) - (if conf-entry - (vhdl-warning-when-idle - "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) - (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-key-list (split-string - (vhdl-match-string-downcase 1) - "[ \t\n\r\f]*,[ \t\n\r\f]*")) - (vhdl-forward-syntactic-ws) - (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?") - (setq - inst-lib-key (vhdl-match-string-downcase 3) - inst-ent-key (and (match-string 2) - (vhdl-match-string-downcase 4)) - inst-arch-key (and (match-string 2) - (vhdl-match-string-downcase 6)) - inst-conf-key (and (not (match-string 2)) - (vhdl-match-string-downcase 4))) - (while inst-key-list - (setq comp-conf-list - (cons (list (car inst-key-list) - inst-comp-key inst-ent-key - inst-arch-key inst-conf-key - inst-lib-key) - comp-conf-list)) - (setq inst-key-list (cdr inst-key-list))))) - (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 (vhdl-aget pack-alist pack-key)) - (pack-line (vhdl-current-line)) - (end-of-unit (vhdl-get-end-of-unit)) - comp-name func-name comp-alist func-alist lib-alist) - (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) - (vhdl-warning-when-idle - "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" - (if is-body " body" "") pack-name - (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) - (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) - file-name (vhdl-current-line)) - ;; scan for context clauses - (setq lib-alist (vhdl-scan-context-clause)) - ;; scan for component and subprogram declarations/bodies - (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t) - (if (equal (upcase (match-string 1)) "COMPONENT") - (setq comp-name (match-string-no-properties 2) - comp-alist - (cons (list (downcase comp-name) comp-name - file-name (vhdl-current-line)) - comp-alist)) - (setq func-name (match-string-no-properties 2) - func-alist - (cons (list (downcase func-name) func-name - file-name (vhdl-current-line)) - func-alist)))) - (setq func-alist (nreverse func-alist)) - (setq comp-alist (nreverse comp-alist)) - (if is-body - (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) - (nth 1 pack-entry) (nth 2 pack-entry) - (nth 3 pack-entry) (nth 4 pack-entry) - (nth 5 pack-entry) - file-name pack-line func-alist lib-alist) - (list pack-name file-name pack-line - comp-alist func-alist lib-alist - (nth 6 pack-entry) (nth 7 pack-entry) - (nth 8 pack-entry) (nth 9 pack-entry)))))))) - ;; scan for hierarchy - (if (and limit-hier-file-size - (< limit-hier-file-size (buffer-size))) - (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) - (setq big-files t)) - ;; 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) - (let* ((ent-name (match-string-no-properties 2)) - (ent-key (downcase ent-name)) - (arch-name (match-string-no-properties 1)) - (arch-key (downcase arch-name)) - (ent-entry (vhdl-aget ent-alist ent-key)) - (arch-alist (nth 3 ent-entry)) - (arch-entry (vhdl-aget arch-alist arch-key)) - (beg-of-unit (point)) - (end-of-unit (vhdl-get-end-of-unit)) - (inst-no 0) - inst-alist inst-path) - ;; scan for contained instantiations - (while (and (re-search-forward - (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" - "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|" - "component[ \t\n\r\f]+\\(\\w+\\)\\|" - "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" - "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" - "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") - end-of-unit t) - (or (not limit-hier-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 - ((match-string 14) - (setq inst-path - (cons (match-string-no-properties 1) inst-path))) - ;; block/generate end found - ((match-string 16) - (setq inst-path (cdr inst-path))) - ;; instantiation found - (t - (let* ((inst-name (match-string-no-properties 1)) - (inst-key (downcase inst-name)) - (inst-comp-name - (or (match-string-no-properties 3) - (match-string-no-properties 6))) - (inst-ent-key - (or (and (match-string 8) - (vhdl-match-string-downcase 11)) - (and inst-comp-name - (downcase inst-comp-name)))) - (inst-arch-key (vhdl-match-string-downcase 13)) - (inst-conf-key - (and (not (match-string 8)) - (vhdl-match-string-downcase 11))) - (inst-lib-key (vhdl-match-string-downcase 10))) - (goto-char (match-end 1)) - (setq inst-list (cons inst-key inst-list) - inst-ent-list - (cons inst-ent-key inst-ent-list)) - (setq inst-alist - (append - inst-alist - (list (list inst-key inst-name file-name - (vhdl-current-line) inst-comp-name - inst-ent-key inst-arch-key - inst-conf-key inst-lib-key - (reverse inst-path))))))))) - ;; scan for contained configuration specifications - (goto-char beg-of-unit) - (while (re-search-forward - (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*" - "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t) - (let* ((inst-comp-name (match-string-no-properties 3)) - (inst-ent-key - (and (match-string 6) - (vhdl-match-string-downcase 9))) - (inst-arch-key (vhdl-match-string-downcase 11)) - (inst-conf-key - (and (not (match-string 6)) - (vhdl-match-string-downcase 9))) - (inst-lib-key (vhdl-match-string-downcase 8)) - (inst-key-list - (split-string (vhdl-match-string-downcase 1) - "[ \t\n\r\f]*,[ \t\n\r\f]*")) - (tmp-inst-alist inst-alist) - inst-entry) - (while tmp-inst-alist - (when (and (or (equal "all" (car inst-key-list)) - (member (nth 0 (car tmp-inst-alist)) - inst-key-list)) - (equal - (downcase - (or (nth 4 (car tmp-inst-alist)) "")) - (downcase inst-comp-name))) - (setq inst-entry (car tmp-inst-alist)) - (setq inst-ent-list - (cons (or inst-ent-key (nth 5 inst-entry)) - (vhdl-delete - (nth 5 inst-entry) inst-ent-list))) - (setq inst-entry - (list (nth 0 inst-entry) (nth 1 inst-entry) - (nth 2 inst-entry) (nth 3 inst-entry) - (nth 4 inst-entry) - (or inst-ent-key (nth 5 inst-entry)) - (or inst-arch-key (nth 6 inst-entry)) - inst-conf-key inst-lib-key)) - (setcar tmp-inst-alist inst-entry)) - (setq tmp-inst-alist (cdr tmp-inst-alist))))) - ;; save in cache - (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 - (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) - (and project (not non-final))) - ;; consistency checks: - ;; check whether each architecture has a corresponding entity - (setq tmp-list ent-alist) - (while tmp-list - (when (null (nth 2 (car tmp-list))) - (setq tmp-entry (car (nth 4 (car tmp-list)))) - (vhdl-warning-when-idle - "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" - (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) - (nth 3 tmp-entry))) - (setq tmp-list (cdr tmp-list))) - ;; check whether configuration has a corresponding entity/architecture - (setq tmp-list conf-alist) - (while tmp-list - (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)))) - (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list))) - (setq tmp-entry (car tmp-list)) - (vhdl-warning-when-idle - "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" - (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) - (nth 2 tmp-entry) (nth 3 tmp-entry))) - (setq tmp-entry (car tmp-list)) - (vhdl-warning-when-idle - "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" - (nth 1 tmp-entry) (nth 4 tmp-entry) - (nth 2 tmp-entry) (nth 3 tmp-entry))) - (setq tmp-list (cdr tmp-list))) - ;; check whether each package body has a package declaration - (setq tmp-list pack-alist) - (while tmp-list - (when (null (nth 2 (car tmp-list))) - (setq tmp-entry (car tmp-list)) - (vhdl-warning-when-idle - "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" - (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) - (setq tmp-list (cdr tmp-list))) - ;; sort lists - (setq ent-alist (vhdl-sort-alist ent-alist)) - (setq conf-alist (vhdl-sort-alist conf-alist)) - (setq pack-alist (vhdl-sort-alist pack-alist)) - ;; remember updated directory/project - (add-to-list 'vhdl-updated-project-list (or project dir-name))) - ;; clear directory alists - (unless project - (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 - (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) - (unless project (message "Scanning directory...done")) - (when big-files - (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) - ;; save cache when scanned non-interactively - (when (or (not project) (not non-final)) - (when (and noninteractive vhdl-speedbar-save-cache) - (vhdl-save-cache key))) - t)) - -(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 (vhdl-aget vhdl-project-alist project)) '(""))) - (default-dir (vhdl-resolve-env-variable - (nth 1 (vhdl-aget vhdl-project-alist project)))) - (file-exclude-regexp - (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) - dir-list-tmp dir dir-name num-dir act-dir recursive) - ;; clear project alists - (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 - (setq dir (vhdl-resolve-env-variable (car dir-list))) - (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) - (setq recursive (match-string 1 dir) - dir-name (match-string 3 dir)) - (setq dir-list-tmp - (cons (concat recursive - (if (file-name-absolute-p dir-name) "" default-dir) - dir-name) - dir-list-tmp)) - (setq dir-list (cdr dir-list))) - ;; resolve path wildcards - (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) - ;; expand directories - (while dir-list-tmp - (setq dir (car dir-list-tmp)) - ;; get subdirectories - (if (string-match "-r \\(.*[/\\]\\)" dir) - (setq dir-list (append dir-list (vhdl-get-subdirs - (match-string 1 dir)))) - (setq dir-list (append dir-list (list dir)))) - (setq dir-list-tmp (cdr dir-list-tmp))) - ;; exclude files - (unless (equal file-exclude-regexp "") - (let ((case-fold-search nil)) - (while dir-list - (unless (string-match file-exclude-regexp (car dir-list)) - (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") - ;; scan for design units for each directory in DIR-LIST - (setq dir-list-tmp nil - num-dir (length dir-list) - act-dir 1) - (while dir-list - (setq dir-name (abbreviate-file-name - (expand-file-name (car dir-list)))) - (vhdl-scan-directory-contents dir-name project nil - (format "(%s/%s) " act-dir num-dir) - (cdr dir-list)) - (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) - (setq dir-list (cdr dir-list) - act-dir (1+ act-dir))) - (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) - (message "Scanning project \"%s\"...done" project))) - -(defun vhdl-update-file-contents (file-name) - "Update hierarchy information by contents of current buffer." - (setq file-name (abbreviate-file-name file-name)) - (let* ((dir-name (file-name-directory file-name)) - (directory-alist vhdl-directory-alist) - updated) - (while directory-alist - (when (member dir-name (nth 1 (car directory-alist))) - (let* ((vhdl-project (nth 0 (car directory-alist))) - (project (vhdl-project-p)) - (ent-alist (vhdl-aget vhdl-entity-alist - (or project dir-name))) - (conf-alist (vhdl-aget vhdl-config-alist - (or project dir-name))) - (pack-alist (vhdl-aget vhdl-package-alist - (or project dir-name))) - (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist - (or project dir-name)))) - (file-alist (vhdl-aget vhdl-file-alist (or project dir-name))) - (file-entry (vhdl-aget file-alist file-name)) - (ent-list (nth 0 file-entry)) - (arch-list (nth 1 file-entry)) - (arch-ent-list (nth 2 file-entry)) - (conf-list (nth 3 file-entry)) - (pack-list (nth 4 file-entry)) - (pack-body-list (nth 5 file-entry)) - (inst-ent-list (nth 7 file-entry)) - (cache-key (or project dir-name)) - arch-alist key ent-key entry) - ;; delete design units previously contained in this file: - ;; entities - (while ent-list - (setq key (car ent-list) - entry (vhdl-aget ent-alist key)) - (when (equal file-name (nth 1 entry)) - (if (nth 3 entry) - (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 (vhdl-aget ent-alist ent-key) - arch-alist (nth 3 entry)) - (when (equal file-name (nth 1 (vhdl-aget arch-alist key))) - (vhdl-adelete 'arch-alist key) - (if (or (nth 1 entry) arch-alist) - (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 (vhdl-aget conf-alist key))) - (vhdl-adelete 'conf-alist key)) - (setq conf-list (cdr conf-list))) - ;; package declarations - (while pack-list - (setq key (car pack-list) - entry (vhdl-aget pack-alist key)) - (when (equal file-name (nth 1 entry)) - (if (nth 6 entry) - (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 (vhdl-aget pack-alist key)) - (when (equal file-name (nth 6 entry)) - (if (nth 1 entry) - (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 - (setq ent-inst-list - (vhdl-delete (car inst-ent-list) ent-inst-list)) - (setq inst-ent-list (cdr inst-ent-list))) - ;; update caches - (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) - (and (not vhdl-speedbar-show-projects) (not project))) - (vhdl-speedbar-refresh project)) - (setq updated t))) - (setq directory-alist (cdr directory-alist))) - updated)) - -(defun vhdl-update-hierarchy () - "Update directory and hierarchy information in speedbar." - (let ((file-list (reverse vhdl-modified-file-list)) - updated) - (when (and vhdl-speedbar-update-on-saving file-list) - (while file-list - (setq updated - (or (vhdl-update-file-contents (car file-list)) - updated)) - (setq file-list (cdr file-list))) - (setq vhdl-modified-file-list nil) - (vhdl-speedbar-update-current-unit) - (when updated (message "Updating hierarchy...done"))))) - -;; structure (parenthesized expression means list of such entries) -;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker -;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker -;; comp-lib-name level) -(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key - conf-key-arg conf-inst-alist level indent - &optional include-top ent-hier) - "Get instantiation hierarchy beginning in architecture ARCH-KEY of -entity ENT-KEY." - (let* ((ent-alist ent-alist-arg) - (conf-alist conf-alist-arg) - (conf-key conf-key-arg) - (ent-entry (vhdl-aget ent-alist ent-key)) - (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) - (cdar (last (nth 3 ent-entry))))) - (inst-alist (nth 3 arch-entry)) - inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry - hier-list subcomp-list tmp-list inst-key inst-comp-name - inst-ent-key inst-arch-key inst-conf-key inst-lib-key) - (when (= level 0) (message "Extract design hierarchy...")) - (when include-top - (setq level (1+ level))) - (when (member ent-key ent-hier) - (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) - ;; process all instances - (while inst-alist - (setq inst-entry (car inst-alist) - inst-key (nth 0 inst-entry) - inst-comp-name (nth 4 inst-entry) - inst-conf-key (nth 7 inst-entry)) - ;; search entry in configuration's instantiations list - (setq tmp-list conf-inst-alist) - (while (and tmp-list - (not (and (member (nth 0 (car tmp-list)) - (list "all" inst-key)) - (equal (nth 1 (car tmp-list)) - (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 (vhdl-aget conf-alist inst-conf-key)) - (when (and inst-conf-key (not inst-conf-entry)) - (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) - ;; determine entity - (setq inst-ent-key - (or (nth 2 (car tmp-list)) ; from configuration - (nth 3 inst-conf-entry) ; from subconfiguration - (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry))) - ; from configuration spec. - (nth 5 inst-entry))) ; from direct instantiation - (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key)) - ;; determine architecture - (setq inst-arch-key - (or (nth 3 (car tmp-list)) ; from configuration - (nth 4 inst-conf-entry) ; from subconfiguration - (nth 6 inst-entry) ; from direct instantiation - (nth 4 (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 (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key)) - ;; set library - (setq inst-lib-key - (or (nth 5 (car tmp-list)) ; from configuration - (nth 8 inst-entry))) ; from direct instantiation - ;; gather information for this instance - (setq comp-entry - (list (nth 1 inst-entry) - (cons (nth 2 inst-entry) (nth 3 inst-entry)) - (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) - (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) - (or (nth 0 inst-arch-entry) inst-arch-key) - (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) - (or (nth 0 inst-conf-entry) inst-conf-key) - (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) - inst-lib-key level)) - ;; get subcomponent hierarchy - (setq subcomp-list (vhdl-get-hierarchy - ent-alist conf-alist - inst-ent-key inst-arch-key inst-conf-key - (nth 5 inst-conf-entry) - (1+ level) indent nil (cons ent-key ent-hier))) - ;; add to list - (setq hier-list (append hier-list (list comp-entry) subcomp-list)) - (setq inst-alist (cdr inst-alist))) - (when include-top - (setq hier-list - (cons (list nil nil (nth 0 ent-entry) - (cons (nth 1 ent-entry) (nth 2 ent-entry)) - (nth 0 arch-entry) - (cons (nth 1 arch-entry) (nth 2 arch-entry)) - nil nil - nil (1- level)) - hier-list))) - (when (or (= level 0) (and include-top (= level 1))) (message "")) - hier-list)) - -(defun vhdl-get-instantiations (ent-key indent) - "Get all instantiations of entity ENT-KEY." - (let ((ent-alist (vhdl-aget vhdl-entity-alist - (vhdl-speedbar-line-key indent))) - arch-alist inst-alist ent-inst-list - ent-entry arch-entry inst-entry) - (while ent-alist - (setq ent-entry (car ent-alist)) - (setq arch-alist (nth 4 ent-entry)) - (while arch-alist - (setq arch-entry (car arch-alist)) - (setq inst-alist (nth 4 arch-entry)) - (while inst-alist - (setq inst-entry (car inst-alist)) - (when (equal ent-key (nth 5 inst-entry)) - (setq ent-inst-list - (cons (list (nth 1 inst-entry) - (cons (nth 2 inst-entry) (nth 3 inst-entry)) - (nth 1 ent-entry) - (cons (nth 2 ent-entry) (nth 3 ent-entry)) - (nth 1 arch-entry) - (cons (nth 2 arch-entry) (nth 3 arch-entry))) - ent-inst-list))) - (setq inst-alist (cdr inst-alist))) - (setq arch-alist (cdr arch-alist))) - (setq ent-alist (cdr ent-alist))) - (nreverse ent-inst-list))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Caching in file - -(defun vhdl-save-caches () - "Save all updated hierarchy caches to file." - (interactive) - (condition-case nil - (when vhdl-speedbar-save-cache - ;; update hierarchy - (vhdl-update-hierarchy) - (let ((project-list vhdl-updated-project-list)) - (message "Saving hierarchy caches...") - ;; write updated project caches - (while project-list - (vhdl-save-cache (car project-list)) - (setq project-list (cdr project-list))) - (message "Saving hierarchy caches...done"))) - (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") - (sit-for 2))))) - -(defvar vhdl-cache-version) - -(defun vhdl-save-cache (key) - "Save current hierarchy cache to file." - (let* ((orig-buffer (current-buffer)) - (vhdl-project key) - (project (vhdl-project-p)) - (default-directory key) - (directory (abbreviate-file-name (vhdl-default-directory))) - (file-name (vhdl-resolve-env-variable - (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) - (concat - (subst-char-in-string ? ?_ (or project "dir")) - " " (user-login-name))))) - (file-dir-name (expand-file-name file-name directory)) - (cache-key (or project directory)) - (key (if project "project" "directory"))) - (unless (file-exists-p (file-name-directory file-dir-name)) - (make-directory (file-name-directory file-dir-name) t)) - (if (not (file-writable-p file-dir-name)) - (progn (vhdl-warning (format "File not writable: \"%s\"" - (abbreviate-file-name file-dir-name))) - (sit-for 2)) - (message "Saving cache: \"%s\"" file-dir-name) - (set-buffer (find-file-noselect file-dir-name t t)) - (erase-buffer) - (insert ";; -*- Emacs-Lisp -*-\n\n" - ";;; " (file-name-nondirectory file-name) - " - design hierarchy cache file for Emacs VHDL Mode " - vhdl-version "\n") - (insert "\n;; " (if project "Project " "Directory") " : ") - (if project (insert project) (prin1 directory (current-buffer))) - (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") - (user-login-name) "\n\n" - "\n;; version number\n" - "(setq vhdl-cache-version \"" vhdl-version "\")\n" - "\n;; " (if project "project" "directory") " name" - "\n(setq " key " ") - (prin1 (or project directory) (current-buffer)) - (insert ")\n") - (when (member 'hierarchy vhdl-speedbar-save-cache) - (insert "\n;; entity and architecture cache\n" - "(vhdl-aput 'vhdl-entity-alist " key " '") - (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer)) - (insert ")\n\n;; configuration cache\n" - "(vhdl-aput 'vhdl-config-alist " key " '") - (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer)) - (insert ")\n\n;; package cache\n" - "(vhdl-aput 'vhdl-package-alist " key " '") - (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer)) - (insert ")\n\n;; instantiated entities cache\n" - "(vhdl-aput 'vhdl-ent-inst-alist " key " '") - (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer)) - (insert ")\n\n;; design units per file cache\n" - "(vhdl-aput 'vhdl-file-alist " key " '") - (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer)) - (when project - (insert ")\n\n;; source directories in project cache\n" - "(vhdl-aput 'vhdl-directory-alist " key " '") - (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer))) - (insert ")\n")) - (when (member 'display vhdl-speedbar-save-cache) - (insert "\n;; shown design units cache\n" - "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") - (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key) - (current-buffer)) - (insert ")\n")) - (setq vhdl-updated-project-list - (delete cache-key vhdl-updated-project-list)) - (save-buffer) - (kill-buffer (current-buffer)) - (set-buffer orig-buffer)))) - -(defun vhdl-load-cache (key) - "Load hierarchy cache information from file." - (let* ((vhdl-project key) - (default-directory key) - (directory (vhdl-default-directory)) - (file-name (vhdl-resolve-env-variable - (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) - (concat - (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) - " " (user-login-name))))) - (file-dir-name (expand-file-name file-name directory)) - vhdl-cache-version) - (unless (memq 'vhdl-save-caches kill-emacs-hook) - (add-hook 'kill-emacs-hook #'vhdl-save-caches)) - (when (file-exists-p file-dir-name) - (condition-case () - (progn (load-file file-dir-name) - (string< (mapconcat - (lambda (a) (format "%3d" (string-to-number a))) - (split-string "3.33" "\\.") "") - (mapconcat - (lambda (a) (format "%3d" (string-to-number a))) - (split-string vhdl-cache-version "\\.") ""))) - (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) - nil)))))) - -(defun vhdl-require-hierarchy-info () - "Make sure that hierarchy information is available. Load cache or scan files -if required." - (if (vhdl-project-p) - (unless (or (assoc vhdl-project vhdl-file-alist) - (vhdl-load-cache vhdl-project)) - (vhdl-scan-project-contents vhdl-project)) - (let ((directory (abbreviate-file-name default-directory))) - (unless (or (assoc directory vhdl-file-alist) - (vhdl-load-cache directory)) - (vhdl-scan-directory-contents directory))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Add hierarchy browser functionality to speedbar - -(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)) -(declare-function speedbar-expand-line "speedbar" (&optional arg)) -(declare-function speedbar-edit-line "speedbar" ()) - -(defun vhdl-speedbar-initialize () - "Initialize speedbar." - ;; general settings - ;; VHDL file extensions (extracted from `auto-mode-alist') - (let ((mode-alist auto-mode-alist)) - (while mode-alist - (when (eq (cdar mode-alist) 'vhdl-mode) - (speedbar-add-supported-extension (caar mode-alist))) - (setq mode-alist (cdr mode-alist)))) - ;; hierarchy browser settings - (when (boundp 'speedbar-mode-functions-list) - ;; special functions - (speedbar-add-mode-functions-list - '("vhdl directory" - (speedbar-item-info . vhdl-speedbar-item-info) - (speedbar-line-directory . speedbar-files-line-directory))) - (speedbar-add-mode-functions-list - '("vhdl project" - (speedbar-item-info . vhdl-speedbar-item-info) - (speedbar-line-directory . vhdl-speedbar-line-project))) - ;; keymap - (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-mode-map (int-to-string key) - `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) - (setq key (1+ key))))) - (define-key speedbar-mode-map "h" - (lambda () (interactive) - (speedbar-change-initial-expansion-list "vhdl directory"))) - (define-key speedbar-mode-map "H" - (lambda () (interactive) - (speedbar-change-initial-expansion-list "vhdl project"))) - ;; menu - (unless vhdl-speedbar-menu-items - (setq - vhdl-speedbar-menu-items - `(["Edit" speedbar-edit-line t] - ["Expand" speedbar-expand-line - (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))] - ["Contract" vhdl-speedbar-contract-level t] - ["Expand All" vhdl-speedbar-expand-all t] - ["Contract All" vhdl-speedbar-contract-all t] - ,(let ((key 0) (menu-list '("Hierarchy Depth"))) - (while (<= key 9) - (setq menu-list - (cons `[,(if (= key 0) "All" (int-to-string key)) - (vhdl-speedbar-set-depth ,key) - :style radio - :selected (= vhdl-speedbar-hierarchy-depth ,key) - :keys ,(int-to-string key)] - menu-list)) - (setq key (1+ key))) - (nreverse menu-list)) - "--" - ["Copy Port/Subprogram" vhdl-speedbar-port-copy - (or (vhdl-speedbar-check-unit 'entity) - (vhdl-speedbar-check-unit 'subprogram))] - ["Place Component" vhdl-speedbar-place-component - (vhdl-speedbar-check-unit 'entity)] - ["Generate Configuration" vhdl-speedbar-configuration - (vhdl-speedbar-check-unit 'architecture)] - ["Select as MRA" vhdl-speedbar-select-mra - (vhdl-speedbar-check-unit 'architecture)] - ["Make" vhdl-speedbar-make-design - (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] - ["Generate Makefile" vhdl-speedbar-generate-makefile - (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] - ["Rescan Directory" vhdl-speedbar-rescan-hierarchy - :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) - ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)] - ["Rescan Project" vhdl-speedbar-rescan-hierarchy - :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) - ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects] - ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) - ;; hook-ups - (speedbar-add-expansion-list - '("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-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)) - speedbar-stealthy-function-list)) - (when (eq vhdl-speedbar-display-mode 'directory) - (setq speedbar-initial-expansion-list-name "vhdl directory")) - (when (eq vhdl-speedbar-display-mode 'project) - (setq speedbar-initial-expansion-list-name "vhdl project")) - (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy))) - -(defun vhdl-speedbar (&optional arg) - "Open/close speedbar." - (interactive) - (if (not (fboundp 'speedbar)) - (error "WARNING: Speedbar is not available or not installed") - (condition-case () - (speedbar-frame-mode arg) - (error (error "WARNING: An error occurred while opening speedbar"))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Display functions - -(defvar vhdl-speedbar-last-selected-project nil - "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." -;; (declare (indent 0) (debug t)) -;; (list 'let '((inhibit-read-only t)) -;; (cons 'progn forms))) - -(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." - (setq vhdl-speedbar-show-projects nil) - (setq speedbar-ignored-directory-regexp - (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) - (setq directory (abbreviate-file-name (file-name-as-directory directory))) - (setq speedbar-last-selected-file nil) - (speedbar-with-writable - (condition-case nil - (progn - ;; insert directory path - (speedbar-directory-buttons directory depth) - ;; insert subdirectories - (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth) - ;; scan and insert hierarchy of current directory - (vhdl-speedbar-insert-dir-hierarchy directory depth - speedbar-power-click) - ;; expand subdirectories - (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) - (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) - -(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan) - "Display projects and hierarchy information in speedbar." - (setq vhdl-speedbar-show-projects t) - (setq speedbar-ignored-directory-regexp ".") - (setq speedbar-last-selected-file nil) - (setq vhdl-speedbar-last-selected-project nil) - (speedbar-with-writable - (condition-case nil - ;; insert projects - (vhdl-speedbar-insert-projects) - (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)) - -(defvar vhdl-speedbar-update-current-unit) - -(defun vhdl-speedbar-insert-projects () - "Insert all projects in speedbar." - (vhdl-speedbar-make-title-line "Projects:") - (let ((project-alist (if vhdl-project-sort - (vhdl-sort-alist (copy-alist vhdl-project-alist)) - vhdl-project-alist)) - (vhdl-speedbar-update-current-unit nil)) - ;; insert projects - (while project-alist - (speedbar-make-tag-line - 'angle ?+ #'vhdl-speedbar-expand-project - (caar project-alist) (caar project-alist) - #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) - (setq project-alist (cdr project-alist))) - (setq project-alist vhdl-project-alist) - ;; expand projects - (while project-alist - (when (member (caar project-alist) vhdl-speedbar-shown-project-list) - (goto-char (point-min)) - (when (re-search-forward - (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))))) - -(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) - "Insert hierarchy of PROJECT. -Rescan directories if optional argument RESCAN is non-nil, -otherwise use cached data." - (when (or rescan (and (not (assoc project vhdl-file-alist)) - (not (vhdl-load-cache project)))) - (vhdl-scan-project-contents project)) - ;; insert design hierarchy - (vhdl-speedbar-insert-hierarchy - (vhdl-aget vhdl-entity-alist project) - (vhdl-aget vhdl-config-alist project) - (vhdl-aget vhdl-package-alist project) - (car (vhdl-aget vhdl-ent-inst-alist project)) indent) - (insert (int-to-string indent) ":\n") - (put-text-property (- (point) 3) (1- (point)) 'invisible t) - (put-text-property (1- (point)) (point) 'invisible nil) - ;; expand design units - (vhdl-speedbar-expand-units project)) - -(defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) - "Insert hierarchy of DIRECTORY. -Rescan directory if optional argument RESCAN is non-nil, -otherwise use cached data." - (when (or rescan (and (not (assoc directory vhdl-file-alist)) - (not (vhdl-load-cache directory)))) - (vhdl-scan-directory-contents directory)) - ;; insert design hierarchy - (vhdl-speedbar-insert-hierarchy - (vhdl-aget vhdl-entity-alist directory) - (vhdl-aget vhdl-config-alist directory) - (vhdl-aget vhdl-package-alist directory) - (car (vhdl-aget vhdl-ent-inst-alist directory)) depth) - ;; expand design units - (vhdl-speedbar-expand-units directory) - (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) - -(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg - pkg-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." - (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) - (vhdl-speedbar-make-title-line "No VHDL design units!" depth) - (let ((ent-alist ent-alist-arg) - (conf-alist conf-alist-arg) - ent-entry conf-entry pack-entry) - ;; insert entities - (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) - (while ent-alist - (setq ent-entry (car ent-alist)) - (speedbar-make-tag-line - 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) - (nth 1 ent-entry) 'vhdl-speedbar-find-file - (cons (nth 2 ent-entry) (nth 3 ent-entry)) - 'vhdl-speedbar-entity-face depth) - (unless (nth 2 ent-entry) - (end-of-line 0) (insert "!") (forward-char 1)) - (unless (member (nth 0 ent-entry) ent-inst-list) - (end-of-line 0) (insert " (top)") (forward-char 1)) - (setq ent-alist (cdr ent-alist))) - ;; insert configurations - (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) - (while conf-alist - (setq conf-entry (car conf-alist)) - (speedbar-make-tag-line - 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) - (nth 1 conf-entry) 'vhdl-speedbar-find-file - (cons (nth 2 conf-entry) (nth 3 conf-entry)) - 'vhdl-speedbar-configuration-face depth) - (setq conf-alist (cdr conf-alist))) - ;; insert packages - (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while pkg-alist - (setq pack-entry (car pkg-alist)) - (vhdl-speedbar-make-pack-line - (nth 0 pack-entry) (nth 1 pack-entry) - (cons (nth 2 pack-entry) (nth 3 pack-entry)) - (cons (nth 7 pack-entry) (nth 8 pack-entry)) - depth) - (setq pkg-alist (cdr pkg-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) - (let (key path) - (cond - ;; current project - (vhdl-speedbar-show-projects - (setq key (vhdl-speedbar-line-project)) - (vhdl-scan-project-contents key)) - ;; top-level directory - ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) - (re-search-forward "[0-9]+:" nil t) - (vhdl-scan-directory-contents - (abbreviate-file-name (speedbar-line-directory)))) - ;; current directory - (t (setq path (speedbar-line-directory)) - (string-match "^\\(.+[/\\]\\)" path) - (vhdl-scan-directory-contents - (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'." - ;; (nicked from `speedbar-default-directory-list') - (let ((sf (cdr (reverse speedbar-shown-directories))) - (vhdl-speedbar-update-current-unit nil)) - (setq speedbar-shown-directories - (list (expand-file-name default-directory))) - (while sf - (when (speedbar-goto-this-file (car sf)) - (beginning-of-line) - (when (looking-at "[0-9]+:\\s-*<") - (goto-char (match-end 0)) - (speedbar-do-function-pointer))) - (setq sf (cdr sf)))) - (vhdl-speedbar-update-current-unit nil t)) - -(defun vhdl-speedbar-expand-units (key) - "Expand design units in directory/project KEY according to -`vhdl-speedbar-shown-unit-alist'." - (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) - (vhdl-speedbar-update-current-unit nil) - vhdl-updated-project-list) - (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)) - (beginning-of-line) - (let ((arch-alist (nth 1 (car unit-alist))) - position) - (when (looking-at "^[0-9]+:\\s-*\\[") - (goto-char (match-end 0)) - (setq position (point)) - (speedbar-do-function-pointer) - (select-frame speedbar-frame) - (while arch-alist ; expand architectures - (goto-char position) - (when (re-search-forward - (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" - (car arch-alist) "\\>\\)") - nil t) - (beginning-of-line) - (when (looking-at "^[0-9]+:\\s-*{") - (goto-char (match-end 0)) - (speedbar-do-function-pointer) - (select-frame speedbar-frame))) - (setq arch-alist (cdr arch-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) - (when (or (save-excursion - (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) - (and (save-excursion - (beginning-of-line) (looking-at "^\\([0-9]+\\):")) - (re-search-backward - (format "^[0-%d]:\\s-*[[{<]-" - (max (1- (string-to-number (match-string 1))) 0)) nil t))) - (goto-char (match-end 0)) - (speedbar-do-function-pointer) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-contract-all () - "Contract all expanded design units in current directory/project." - (interactive) - (if (and vhdl-speedbar-show-projects - (save-excursion (beginning-of-line) (looking-at "^0:"))) - (progn (setq vhdl-speedbar-shown-project-list nil) - (vhdl-speedbar-refresh)) - (let ((key (vhdl-speedbar-line-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))))) - -(defun vhdl-speedbar-expand-all () - "Expand all design units in current directory/project." - (interactive) - (let* ((key (vhdl-speedbar-line-key)) - (ent-alist (vhdl-aget vhdl-entity-alist key)) - (conf-alist (vhdl-aget vhdl-config-alist key)) - (pack-alist (vhdl-aget vhdl-package-alist key)) - arch-alist unit-alist subunit-alist) - (add-to-list 'vhdl-speedbar-shown-project-list key) - (while ent-alist - (setq arch-alist (nth 4 (car ent-alist))) - (setq subunit-alist nil) - (while arch-alist - (push (caar arch-alist) subunit-alist) - (setq arch-alist (cdr arch-alist))) - (push (list (caar ent-alist) subunit-alist) unit-alist) - (setq ent-alist (cdr ent-alist))) - (while conf-alist - (push (list (caar conf-alist)) unit-alist) - (setq conf-alist (cdr conf-alist))) - (while pack-alist - (push (list (caar pack-alist)) unit-alist) - (setq pack-alist (cdr pack-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 - ((string-match "\\+" text) ; expand project - (speedbar-change-expand-button-char ?-) - (unless (member token vhdl-speedbar-shown-project-list) - (setq vhdl-speedbar-shown-project-list - (cons token vhdl-speedbar-shown-project-list))) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - (vhdl-speedbar-insert-project-hierarchy token (1+ indent) - speedbar-power-click)))) - ((string-match "-" text) ; contract project - (speedbar-change-expand-button-char ?+) - (setq vhdl-speedbar-shown-project-list - (delete token vhdl-speedbar-shown-project-list)) - (speedbar-delete-subblock indent)) - (t (error "Nothing to display"))) - (when (equal (selected-frame) speedbar-frame) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-expand-entity (text token indent) - "Expand/contract the entity under the cursor." - (cond - ((string-match "\\+" text) ; expand entity - (let* ((key (vhdl-speedbar-line-key indent)) - (ent-alist (vhdl-aget vhdl-entity-alist key)) - (ent-entry (vhdl-aget ent-alist token)) - (arch-alist (nth 3 ent-entry)) - (inst-alist (vhdl-get-instantiations token indent)) - (subpack-alist (nth 5 ent-entry)) - (multiple-arch (> (length arch-alist) 1)) - arch-entry inst-entry) - (if (not (or arch-alist inst-alist subpack-alist)) - (speedbar-change-expand-button-char ??) - (speedbar-change-expand-button-char ?-) - ;; add entity to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-aput 'unit-alist token nil) - (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - ;; insert architectures - (when arch-alist - (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) - (while arch-alist - (setq arch-entry (car arch-alist)) - (speedbar-make-tag-line - 'curly ?+ 'vhdl-speedbar-expand-architecture - (cons token (nth 0 arch-entry)) - (nth 1 arch-entry) 'vhdl-speedbar-find-file - (cons (nth 2 arch-entry) (nth 3 arch-entry)) - 'vhdl-speedbar-architecture-face (1+ indent)) - (when (and multiple-arch - (equal (nth 0 arch-entry) (nth 4 ent-entry))) - (end-of-line 0) (insert " (mra)") (forward-char 1)) - (setq arch-alist (cdr arch-alist))) - ;; insert instantiations - (when inst-alist - (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) - (while inst-alist - (setq inst-entry (car inst-alist)) - (vhdl-speedbar-make-inst-line - (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) - (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) - nil nil nil (1+ indent) 0 " in ") - (setq inst-alist (cdr inst-alist))) - ;; insert required packages - (vhdl-speedbar-insert-subpackages - subpack-alist (1+ indent) indent))) - (when (memq 'display vhdl-speedbar-save-cache) - (add-to-list 'vhdl-updated-project-list key)) - (vhdl-speedbar-update-current-unit t t)))) - ((string-match "-" text) ; contract entity - (speedbar-change-expand-button-char ?+) - ;; remove entity from `vhdl-speedbar-shown-unit-alist' - (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-adelete 'unit-alist token) - (if unit-alist - (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)))) - (t (error "Nothing to display"))) - (when (equal (selected-frame) speedbar-frame) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-expand-architecture (text token indent) - "Expand/contract the architecture under the cursor." - (cond - ((string-match "\\+" text) ; expand architecture - (let* ((key (vhdl-speedbar-line-key (1- indent))) - (ent-alist (vhdl-aget vhdl-entity-alist key)) - (conf-alist (vhdl-aget vhdl-config-alist key)) - (hier-alist (vhdl-get-hierarchy - ent-alist conf-alist (car token) (cdr token) nil nil - 0 (1- indent))) - (ent-entry (vhdl-aget ent-alist (car token))) - (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token))) - (subpack-alist (nth 4 arch-entry)) - entry) - (if (not (or hier-alist subpack-alist)) - (speedbar-change-expand-button-char ??) - (speedbar-change-expand-button-char ?-) - ;; add architecture to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) - (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) - (vhdl-aput 'unit-alist (car token) - (list (cons (cdr token) arch-alist))) - (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - ;; insert instance hierarchy - (when hier-alist - (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" - (1+ indent))) - (while hier-alist - (setq entry (car hier-alist)) - (when (or (= vhdl-speedbar-hierarchy-depth 0) - (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) - (vhdl-speedbar-make-inst-line - (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) - (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) - (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) - (setq hier-alist (cdr hier-alist))) - ;; insert required packages - (vhdl-speedbar-insert-subpackages - subpack-alist (1+ indent) (1- indent)))) - (when (memq 'display vhdl-speedbar-save-cache) - (add-to-list 'vhdl-updated-project-list key)) - (vhdl-speedbar-update-current-unit t t)))) - ((string-match "-" text) ; contract architecture - (speedbar-change-expand-button-char ?+) - ;; remove architecture from `vhdl-speedbar-shown-unit-alist' - (let* ((key (vhdl-speedbar-line-key (1- indent))) - (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) - (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) - (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) - (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (speedbar-delete-subblock indent) - (when (memq 'display vhdl-speedbar-save-cache) - (add-to-list 'vhdl-updated-project-list key)))) - (t (error "Nothing to display"))) - (when (equal (selected-frame) speedbar-frame) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-expand-config (text token indent) - "Expand/contract the configuration under the cursor." - (cond - ((string-match "\\+" text) ; expand configuration - (let* ((key (vhdl-speedbar-line-key indent)) - (conf-alist (vhdl-aget vhdl-config-alist key)) - (conf-entry (vhdl-aget conf-alist token)) - (ent-alist (vhdl-aget vhdl-entity-alist key)) - (hier-alist (vhdl-get-hierarchy - ent-alist conf-alist (nth 3 conf-entry) - (nth 4 conf-entry) token (nth 5 conf-entry) - 0 indent t)) - (subpack-alist (nth 6 conf-entry)) - entry) - (if (not (or hier-alist subpack-alist)) - (speedbar-change-expand-button-char ??) - (speedbar-change-expand-button-char ?-) - ;; add configuration to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-aput 'unit-alist token nil) - (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - ;; insert instance hierarchy - (when hier-alist - (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) - (while hier-alist - (setq entry (car hier-alist)) - (when (or (= vhdl-speedbar-hierarchy-depth 0) - (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) - (vhdl-speedbar-make-inst-line - (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) - (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) - (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) - (setq hier-alist (cdr hier-alist))) - ;; insert required packages - (vhdl-speedbar-insert-subpackages - subpack-alist (1+ indent) indent))) - (when (memq 'display vhdl-speedbar-save-cache) - (add-to-list 'vhdl-updated-project-list key)) - (vhdl-speedbar-update-current-unit t t)))) - ((string-match "-" text) ; contract configuration - (speedbar-change-expand-button-char ?+) - ;; remove configuration from `vhdl-speedbar-shown-unit-alist' - (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-adelete 'unit-alist token) - (if unit-alist - (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)))) - (t (error "Nothing to display"))) - (when (equal (selected-frame) speedbar-frame) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-expand-package (text token indent) - "Expand/contract the package under the cursor." - (cond - ((string-match "\\+" text) ; expand package - (let* ((key (vhdl-speedbar-line-key indent)) - (pack-alist (vhdl-aget vhdl-package-alist key)) - (pack-entry (vhdl-aget pack-alist token)) - (comp-alist (nth 3 pack-entry)) - (func-alist (nth 4 pack-entry)) - (func-body-alist (nth 8 pack-entry)) - (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) - comp-entry func-entry func-body-entry) - (if (not (or comp-alist func-alist subpack-alist)) - (speedbar-change-expand-button-char ??) - (speedbar-change-expand-button-char ?-) - ;; add package to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-aput 'unit-alist token nil) - (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - ;; insert components - (when comp-alist - (vhdl-speedbar-make-title-line "Components:" (1+ indent))) - (while comp-alist - (setq comp-entry (car comp-alist)) - (speedbar-make-tag-line - nil nil nil - (cons token (nth 0 comp-entry)) - (nth 1 comp-entry) 'vhdl-speedbar-find-file - (cons (nth 2 comp-entry) (nth 3 comp-entry)) - 'vhdl-speedbar-entity-face (1+ indent)) - (setq comp-alist (cdr comp-alist))) - ;; insert subprograms - (when func-alist - (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) - (while func-alist - (setq func-entry (car func-alist) - func-body-entry (vhdl-aget func-body-alist - (car func-entry))) - (when (nth 2 func-entry) - (vhdl-speedbar-make-subprogram-line - (nth 1 func-entry) - (cons (nth 2 func-entry) (nth 3 func-entry)) - (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) - (1+ indent))) - (setq func-alist (cdr func-alist))) - ;; insert required packages - (vhdl-speedbar-insert-subpackages - subpack-alist (1+ indent) indent))) - (when (memq 'display vhdl-speedbar-save-cache) - (add-to-list 'vhdl-updated-project-list key)) - (vhdl-speedbar-update-current-unit t t)))) - ((string-match "-" text) ; contract package - (speedbar-change-expand-button-char ?+) - ;; remove package from `vhdl-speedbar-shown-unit-alist' - (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) - (vhdl-adelete 'unit-alist token) - (if unit-alist - (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)))) - (t (error "Nothing to display"))) - (when (equal (selected-frame) speedbar-frame) - (speedbar-center-buffer-smartly))) - -(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) - "Insert required packages." - (let* ((pack-alist (vhdl-aget vhdl-package-alist - (vhdl-speedbar-line-key dir-indent))) - pack-key lib-name pack-entry) - (when subpack-alist - (vhdl-speedbar-make-title-line "Packages Used:" indent)) - (while subpack-alist - (setq pack-key (cdar subpack-alist) - lib-name (caar subpack-alist)) - (setq pack-entry (vhdl-aget pack-alist pack-key)) - (vhdl-speedbar-make-subpack-line - (or (nth 0 pack-entry) pack-key) lib-name - (cons (nth 1 pack-entry) (nth 2 pack-entry)) - (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) - (setq subpack-alist (cdr subpack-alist))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Display help functions - -;; FIXME: This `defvar' should be moved before its first use. -(defvar vhdl-speedbar-update-current-unit t - "Non-nil means to run `vhdl-speedbar-update-current-unit'.") - -(defun vhdl-speedbar-update-current-project () - "Highlight project that is currently active." - (when (and vhdl-speedbar-show-projects - (not (equal vhdl-speedbar-last-selected-project vhdl-project)) - (and (boundp 'speedbar-frame) - (frame-live-p speedbar-frame))) - (let ((last-frame (selected-frame)) - (project-alist vhdl-project-alist) - pos) - (select-frame speedbar-frame) - (speedbar-with-writable - (save-excursion - (while project-alist - (goto-char (point-min)) - (when (re-search-forward - (concat "<.> \\(" (caar project-alist) "\\)$") nil t) - (put-text-property (match-beginning 1) (match-end 1) 'face - (if (equal (caar project-alist) vhdl-project) - 'speedbar-selected-face - 'speedbar-directory-face)) - (when (equal (caar project-alist) vhdl-project) - (setq pos (1- (match-beginning 1))))) - (setq project-alist (cdr project-alist)))) - (when pos (goto-char pos))) - (select-frame last-frame) - (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." - (let ((last-frame (selected-frame)) - (project-list vhdl-speedbar-shown-project-list) - file-alist pos file-name) - ;; get current file name - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame)) - (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) - (when (and vhdl-speedbar-update-current-unit - (or always (not (equal file-name speedbar-last-selected-file)))) - (if vhdl-speedbar-show-projects - (while project-list - (setq file-alist (append file-alist - (vhdl-aget vhdl-file-alist - (car project-list)))) - (setq project-list (cdr project-list))) - (setq file-alist - (vhdl-aget vhdl-file-alist - (abbreviate-file-name default-directory)))) - (select-frame speedbar-frame) - (set-buffer speedbar-buffer) - (speedbar-with-writable - (vhdl-prepare-search-1 - (save-excursion - ;; unhighlight last units - (let* ((file-entry (vhdl-aget file-alist - speedbar-last-selected-file))) - (vhdl-speedbar-update-units - "\\[.] " (nth 0 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-entity-face) - (vhdl-speedbar-update-units - "{.} " (nth 1 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-architecture-face) - (vhdl-speedbar-update-units - "\\[.] " (nth 3 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-configuration-face) - (vhdl-speedbar-update-units - "[]>] " (nth 4 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-package-face) - (vhdl-speedbar-update-units - "\\[.].+(" '("body") - speedbar-last-selected-file 'vhdl-speedbar-package-face) - (vhdl-speedbar-update-units - "> " (nth 6 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) - ;; highlight current units - (let* ((file-entry (vhdl-aget file-alist file-name))) - (setq - pos (vhdl-speedbar-update-units - "\\[.] " (nth 0 file-entry) - file-name 'vhdl-speedbar-entity-selected-face pos) - pos (vhdl-speedbar-update-units - "{.} " (nth 1 file-entry) - file-name 'vhdl-speedbar-architecture-selected-face pos) - pos (vhdl-speedbar-update-units - "\\[.] " (nth 3 file-entry) - file-name 'vhdl-speedbar-configuration-selected-face pos) - pos (vhdl-speedbar-update-units - "[]>] " (nth 4 file-entry) - file-name 'vhdl-speedbar-package-selected-face pos) - pos (vhdl-speedbar-update-units - "\\[.].+(" '("body") - file-name 'vhdl-speedbar-package-selected-face pos) - pos (vhdl-speedbar-update-units - "> " (nth 6 file-entry) - file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) - ;; move speedbar so the first highlighted unit is visible - (when (and pos (not no-position)) - (goto-char pos) - (speedbar-center-buffer-smartly) - (speedbar-position-cursor-on-line)) - (setq speedbar-last-selected-file file-name)) - (select-frame last-frame) - t)) - -(defun vhdl-speedbar-update-units (text unit-list file-name face - &optional pos) - "Help function to highlight design units." - (while unit-list - (goto-char (point-min)) - (while (re-search-forward - (concat text "\\(" (car unit-list) "\\)\\>") nil t) - (when (equal file-name (car (get-text-property - (match-beginning 1) 'speedbar-token))) - (setq pos (or pos (point-marker))) - (put-text-property (match-beginning 1) (match-end 1) 'face face))) - (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 - conf-name conf-file-marker - lib-name depth offset delimiter) - "Insert instantiation entry." - (let ((start (point)) - visible-start) - (insert (int-to-string depth) ":") - (put-text-property start (point) 'invisible t) - (setq visible-start (point)) - (insert-char ? (* depth speedbar-indentation-width)) - (while (> offset 0) - (insert "|") - (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) - (setq offset (1- offset))) - (put-text-property visible-start (point) 'invisible nil) - (setq start (point)) - (insert ">") - (speedbar-make-button start (point) nil nil nil) - (setq visible-start (point)) - (insert " ") - (setq start (point)) - (if (not inst-name) - (insert "(top)") - (insert inst-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file inst-file-marker)) - (insert delimiter) - (when ent-name - (setq start (point)) - (insert ent-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file ent-file-marker) - (when arch-name - (insert " (") - (setq start (point)) - (insert arch-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file arch-file-marker) - (insert ")")) - (when conf-name - (insert " (") - (setq start (point)) - (insert conf-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file conf-file-marker) - (insert ")"))) - (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) - (setq start (point)) - (insert " (" lib-name ")") - (put-text-property (+ 2 start) (1- (point)) 'face - 'vhdl-speedbar-library-face)) - (insert-char ?\n 1) - (put-text-property visible-start (point) 'invisible nil))) - -(defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker - body-file-marker depth) - "Insert package entry." - (let ((start (point)) - visible-start) - (insert (int-to-string depth) ":") - (put-text-property start (point) 'invisible t) - (setq visible-start (point)) - (insert-char ? (* depth speedbar-indentation-width)) - (put-text-property visible-start (point) 'invisible nil) - (setq start (point)) - (insert "[+]") - (speedbar-make-button - start (point) 'speedbar-button-face 'speedbar-highlight-face - 'vhdl-speedbar-expand-package pack-key) - (setq visible-start (point)) - (insert-char ? 1 nil) - (setq start (point)) - (insert pack-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file pack-file-marker) - (unless (car pack-file-marker) - (insert "!")) - (when (car body-file-marker) - (insert " (") - (setq start (point)) - (insert "body") - (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file body-file-marker) - (insert ")")) - (insert-char ?\n 1) - (put-text-property visible-start (point) 'invisible nil))) - -(defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker - pack-body-file-marker depth) - "Insert used package entry." - (let ((start (point)) - visible-start) - (insert (int-to-string depth) ":") - (put-text-property start (point) 'invisible t) - (setq visible-start (point)) - (insert-char ? (* depth speedbar-indentation-width)) - (put-text-property visible-start (point) 'invisible nil) - (setq start (point)) - (insert ">") - (speedbar-make-button start (point) nil nil nil) - (setq visible-start (point)) - (insert " ") - (setq start (point)) - (insert pack-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file pack-file-marker) - (when (car pack-body-file-marker) - (insert " (") - (setq start (point)) - (insert "body") - (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file pack-body-file-marker) - (insert ")")) - (setq start (point)) - (insert " (" lib-name ")") - (put-text-property (+ 2 start) (1- (point)) 'face - 'vhdl-speedbar-library-face) - (insert-char ?\n 1) - (put-text-property visible-start (point) 'invisible nil))) - -(defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker - func-body-file-marker - depth) - "Insert subprogram entry." - (let ((start (point)) - visible-start) - (insert (int-to-string depth) ":") - (put-text-property start (point) 'invisible t) - (setq visible-start (point)) - (insert-char ? (* depth speedbar-indentation-width)) - (put-text-property visible-start (point) 'invisible nil) - (setq start (point)) - (insert ">") - (speedbar-make-button start (point) nil nil nil) - (setq visible-start (point)) - (insert " ") - (setq start (point)) - (insert func-name) - (speedbar-make-button - start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file func-file-marker) - (when (car func-body-file-marker) - (insert " (") - (setq start (point)) - (insert "body") - (speedbar-make-button - start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face - 'vhdl-speedbar-find-file func-body-file-marker) - (insert ")")) - (insert-char ?\n 1) - (put-text-property visible-start (point) 'invisible nil))) - -(defun vhdl-speedbar-make-title-line (text &optional depth) - "Insert design unit title entry." - (let ((start (point)) - visible-start) - (when depth - (insert (int-to-string depth) ":") - (put-text-property start (point) 'invisible t)) - (setq visible-start (point)) - (insert-char ? (* (or depth 0) speedbar-indentation-width)) - (setq start (point)) - (insert text) - (speedbar-make-button start (point) nil nil nil nil) - (insert-char ?\n 1) - (put-text-property visible-start (point) 'invisible nil))) - -(defun vhdl-speedbar-insert-dirs (files level) - "Insert subdirectories." - (let ((dirs (car files))) - (while dirs - (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) - (car dirs) 'speedbar-dir-follow nil - '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 - (setq speedbar-shown-directories - (cons (expand-file-name - (concat (speedbar-line-directory indent) token "/")) - speedbar-shown-directories)) - (speedbar-change-expand-button-char ?-) - (speedbar-reset-scanners) - (speedbar-with-writable - (save-excursion - (end-of-line) (forward-char 1) - (vhdl-speedbar-insert-dirs - (speedbar-file-lists - (concat (speedbar-line-directory indent) token "/")) - (1+ indent)) - (speedbar-reset-scanners) - (vhdl-speedbar-insert-dir-hierarchy - (abbreviate-file-name - (concat (speedbar-line-directory indent) token "/")) - (1+ indent) speedbar-power-click))) - (vhdl-speedbar-update-current-unit t t)) - ((string-match "-" text) ; we have to contract this node - (speedbar-reset-scanners) - (let ((oldl speedbar-shown-directories) - (newl nil) - (td (expand-file-name - (concat (speedbar-line-directory indent) token)))) - (while oldl - (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) - (push (car oldl) newl)) - (setq oldl (cdr oldl))) - (setq speedbar-shown-directories (nreverse newl))) - (speedbar-change-expand-button-char ?+) - (speedbar-delete-subblock indent)) - (t (error "Nothing to display"))) - (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 - (beginning-of-line) - ;; skip invisible number info - (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) - (cond - ;; project/directory entry - ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") - (if vhdl-speedbar-show-projects - (message "Project \"%s\"" (match-string-no-properties 1)) - (speedbar-files-item-info))) - ;; design unit entry - ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") - (goto-char (match-end 1)) - (let ((face (get-text-property (point) 'face))) - (message - "%s \"%s\" in \"%s\"" - ;; design unit kind - (cond ((or (eq face 'vhdl-speedbar-entity-face) - (eq face 'vhdl-speedbar-entity-selected-face)) - (if (equal (match-string 2) ">") "Component" "Entity")) - ((or (eq face 'vhdl-speedbar-architecture-face) - (eq face 'vhdl-speedbar-architecture-selected-face)) - "Architecture") - ((or (eq face 'vhdl-speedbar-configuration-face) - (eq face 'vhdl-speedbar-configuration-selected-face)) - "Configuration") - ((or (eq face 'vhdl-speedbar-package-face) - (eq face 'vhdl-speedbar-package-selected-face)) - "Package") - ((or (eq face 'vhdl-speedbar-instantiation-face) - (eq face 'vhdl-speedbar-instantiation-selected-face)) - "Instantiation") - ((eq face 'vhdl-speedbar-subprogram-face) - "Subprogram") - (t "")) - ;; design unit name - (buffer-substring-no-properties - (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) - (match-end 1)) - ;; file name - (file-relative-name - (or (car (get-text-property (point) 'speedbar-token)) - "?") - (vhdl-default-directory))))) - (t (message ""))))) - -(declare-function speedbar-line-text "speedbar" (&optional p)) - -(defun vhdl-speedbar-line-text () - "Call `speedbar-line-text' and remove text properties." - (let ((string (speedbar-line-text))) - (set-text-properties 0 (length string) nil string) - string)) - -(defun vhdl-speedbar-higher-text () - "Get speedbar-line-text of higher level." - (let (depth string) - (save-excursion - (beginning-of-line) - (looking-at "^\\([0-9]+\\):") - (setq depth (string-to-number (match-string 1))) - (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) - (setq string (match-string 1)) - (set-text-properties 0 (length string) nil string) - string)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Help functions - -(defun vhdl-speedbar-line-key (&optional indent) - "Get currently displayed directory of project name." - (if vhdl-speedbar-show-projects - (vhdl-speedbar-line-project) - (abbreviate-file-name - (file-name-as-directory (speedbar-line-directory indent))))) - -(defun vhdl-speedbar-line-project (&optional _indent) - "Get currently displayed project name." - (and vhdl-speedbar-show-projects - (save-excursion - (end-of-line) - (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) - (match-string-no-properties 1)))) - -(defun vhdl-add-modified-file () - "Add file to `vhdl-modified-file-list'." - (when vhdl-file-alist - (add-to-list 'vhdl-modified-file-list (buffer-file-name))) - nil) - -(defun vhdl-resolve-paths (path-list) - "Resolve path wildcards in PATH-LIST." - (let (path-list-1 path-list-2 path-beg path-end dir) - ;; eliminate non-existent directories - (while path-list - (setq dir (car path-list)) - (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) - (if (file-directory-p (match-string 2 dir)) - (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 - (while path-list-1 - (setq dir (car path-list-1)) - (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) - (progn - (setq path-beg (match-string 1 dir) - path-end (match-string 5 dir)) - (setq path-list-1 - (append - (mapcar - (lambda (var) (concat path-beg var path-end)) - (let ((all-list (vhdl-directory-files - (match-string 2 dir) t - (concat "\\<" (wildcard-to-regexp - (match-string 4 dir))))) - dir-list) - (while all-list - (when (file-directory-p (car all-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)) - (push dir path-list-2)) - (setq path-list-1 (cdr path-list-1)))) - (nreverse path-list-2))) - -(defun vhdl-speedbar-goto-this-unit (directory unit) - "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." - (let ((dest (point))) - (if (and (if vhdl-speedbar-show-projects - (progn (goto-char (point-min)) t) - (speedbar-goto-this-file directory)) - (re-search-forward (concat "[]}] " unit "\\>") nil t)) - (progn (speedbar-position-cursor-on-line) - t) - (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 -is already shown in a buffer." - (if (not (car token)) - (error "ERROR: File cannot be found") - (let ((buffer (get-file-buffer (car token)))) - (speedbar-find-file-in-frame (car token)) - (when (or vhdl-speedbar-jump-to-unit buffer) - (goto-char (point-min)) - (forward-line (1- (cdr token))) - (recenter)) - (vhdl-speedbar-update-current-unit t t) - (speedbar-set-timer dframe-update-speed) - (dframe-maybee-jump-to-attached-frame)))) - -(defun vhdl-speedbar-port-copy () - "Copy the port of the entity/component or subprogram under the cursor." - (interactive) - (let ((is-entity (vhdl-speedbar-check-unit 'entity))) - (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) - (error "ERROR: No entity/component or subprogram under cursor") - (beginning-of-line) - (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") - (condition-case info - (let ((token (get-text-property - (match-beginning 3) 'speedbar-token))) - (vhdl-visit-file (car token) t - (goto-char (point-min)) - (forward-line (1- (cdr token))) - (end-of-line) - (if is-entity - (vhdl-port-copy) - (vhdl-subprog-copy)))) - (error (error "ERROR: %s not scanned successfully\n (%s)" - (if is-entity "Port" "Interface") (cadr info)))) - (error "ERROR: No entity/component or subprogram on current line"))))) - -(defun vhdl-speedbar-place-component () - "Place the entity/component under the cursor as component." - (interactive) - (if (not (vhdl-speedbar-check-unit 'entity)) - (error "ERROR: No entity/component under cursor") - (vhdl-speedbar-port-copy) - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame)) - (vhdl-compose-place-component) - (select-frame speedbar-frame))) - -(defun vhdl-speedbar-configuration () - "Generate configuration for the architecture under the cursor." - (interactive) - (if (not (vhdl-speedbar-check-unit 'architecture)) - (error "ERROR: No architecture under cursor") - (let ((arch-name (vhdl-speedbar-line-text)) - (ent-name (vhdl-speedbar-higher-text))) - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame)) - (vhdl-compose-configuration ent-name arch-name)))) - -(defun vhdl-speedbar-select-mra () - "Select the architecture under the cursor as MRA." - (interactive) - (if (not (vhdl-speedbar-check-unit 'architecture)) - (error "ERROR: No architecture under cursor") - (let* ((arch-key (downcase (vhdl-speedbar-line-text))) - (ent-key (downcase (vhdl-speedbar-higher-text))) - (ent-alist (vhdl-aget - vhdl-entity-alist - (or (vhdl-project-p) - (abbreviate-file-name default-directory)))) - (ent-entry (vhdl-aget ent-alist ent-key))) - (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) - (speedbar-refresh)))) - -(declare-function speedbar-line-file "speedbar" (&optional p)) - -(defun vhdl-speedbar-make-design () - "Make (compile) design unit or directory/project under the cursor." - (interactive) - (if (not (save-excursion (beginning-of-line) - (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) - (error "ERROR: No primary design unit or directory/project under cursor") - (let ((is-unit (match-string 2)) - (unit-name (vhdl-speedbar-line-text)) - (vhdl-project (vhdl-speedbar-line-project)) - (directory (file-name-as-directory - (or (speedbar-line-file) (speedbar-line-directory))))) - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame)) - (let ((default-directory directory)) - (vhdl-make (and is-unit unit-name)))))) - -(defun vhdl-speedbar-generate-makefile () - "Generate Makefile for directory/project under the cursor." - (interactive) - (let ((vhdl-project (vhdl-speedbar-line-project)) - (default-directory (file-name-as-directory - (or (speedbar-line-file) (speedbar-line-directory))))) - (vhdl-generate-makefile))) - -(defun vhdl-speedbar-check-unit (design-unit) - "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its -expansion function)." - (save-excursion - (speedbar-position-cursor-on-line) - (cond ((eq design-unit 'entity) - (memq (get-text-property (match-end 0) 'face) - '(vhdl-speedbar-entity-face - vhdl-speedbar-entity-selected-face))) - ((eq design-unit 'architecture) - (memq (get-text-property (match-end 0) 'face) - '(vhdl-speedbar-architecture-face - vhdl-speedbar-architecture-selected-face))) - ((eq design-unit 'subprogram) - (eq (get-text-property (match-end 0) 'face) - 'vhdl-speedbar-subprogram-face)) - (t nil)))) - -(defun vhdl-speedbar-set-depth (depth) - "Set hierarchy display depth to DEPTH and refresh speedbar." - (setq vhdl-speedbar-hierarchy-depth depth) - (speedbar-refresh)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Fontification - -(defface vhdl-speedbar-entity-face - '((((class color) (background light)) (:foreground "ForestGreen")) - (((class color) (background dark)) (:foreground "PaleGreen"))) - "Face used for displaying entity names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-architecture-face - '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) - (((class color) (background light)) (:foreground "Blue")) - - (((class color) (background dark)) (:foreground "LightSkyBlue"))) - "Face used for displaying architecture names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-configuration-face - '((((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "Salmon"))) - "Face used for displaying configuration names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-package-face - '((((class color) (background light)) (:foreground "Grey50")) - (((class color) (background dark)) (:foreground "Grey80"))) - "Face used for displaying package names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-library-face - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Orchid1"))) - "Face used for displaying library names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-instantiation-face - '((((class color) (background light)) (:foreground "Brown")) - (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) - (((class color) (background dark)) (:foreground "Yellow"))) - "Face used for displaying instantiation names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-subprogram-face - '((((class color) (background light)) (:foreground "Orchid4")) - (((class color) (background dark)) (:foreground "BurlyWood2"))) - "Face used for displaying subprogram names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-entity-selected-face - '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) - (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) - "Face used for displaying entity names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-architecture-selected-face - '((((min-colors 88) (class color) (background light)) (:foreground - "Blue1" :underline t)) - (((class color) (background light)) (:foreground "Blue" :underline t)) - (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) - "Face used for displaying architecture names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-configuration-selected-face - '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) - (((class color) (background dark)) (:foreground "Salmon" :underline t))) - "Face used for displaying configuration names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-package-selected-face - '((((class color) (background light)) (:foreground "Grey50" :underline t)) - (((class color) (background dark)) (:foreground "Grey80" :underline t))) - "Face used for displaying package names." - :group 'speedbar-faces) - -(defface vhdl-speedbar-instantiation-selected-face - '((((class color) (background light)) (:foreground "Brown" :underline t)) - (((class color) (background dark)) (:foreground "Yellow" :underline t))) - "Face used for displaying instantiation names." - :group 'speedbar-faces) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Initialization - -;; add speedbar -(when (fboundp '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)) - (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize)) - (vhdl-speedbar-initialize) - (when speedbar-frame (vhdl-speedbar-refresh))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Structural composition -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun vhdl-get-components-package-name () - "Return the name of the components package." - (let ((project (vhdl-project-p))) - (if project - (vhdl-replace-string (car vhdl-components-package-name) - (subst-char-in-string ? ?_ project)) - (cdr vhdl-components-package-name)))) - -(defun vhdl-compose-new-component () - "Create entity and architecture for new component." - (interactive) - (let* ((case-fold-search t) - (ent-name (read-from-minibuffer "entity name: " - nil vhdl-minibuffer-local-map)) - (arch-name - (if (equal (cdr vhdl-compose-architecture-name) "") - (read-from-minibuffer "architecture name: " - nil vhdl-minibuffer-local-map) - (vhdl-replace-string vhdl-compose-architecture-name ent-name))) - ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project - (message "Creating component \"%s(%s)\"..." ent-name arch-name) - ;; open entity file - (unless (eq vhdl-compose-create-files 'none) - (setq ent-file-name - (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) - "." (file-name-extension (buffer-file-name)))) - (when (and (file-exists-p ent-file-name) - (not (y-or-n-p (concat "File \"" ent-file-name - "\" exists; overwrite? ")))) - (error "ERROR: Creating component...aborted")) - (find-file ent-file-name) - (erase-buffer) - (set-buffer-modified-p nil)) - ;; insert header - (if vhdl-compose-include-header - (progn (vhdl-template-header) - (setq end-pos (point)) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n")) - ;; insert library clause - (vhdl-template-package-std-logic-1164) - (when vhdl-use-components-package - (insert "\n") - (vhdl-template-standard-package (vhdl-work-library) - (vhdl-get-components-package-name))) - (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") - ;; insert entity declaration - (vhdl-insert-keyword "ENTITY ") (insert ent-name) - (vhdl-insert-keyword " IS\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") - (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") - (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") - (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) - (insert ent-name ";\n\n") - (vhdl-comment-display-line) (insert "\n") - ;; open architecture file - (if (not (eq vhdl-compose-create-files 'separate)) - (insert "\n") - (goto-char (or end-pos (point-min))) - (setq ent-buffer (current-buffer)) - (setq arch-file-name - (concat (vhdl-replace-string vhdl-architecture-file-name - (concat ent-name " " arch-name) t) - "." (file-name-extension (buffer-file-name)))) - (when (and (file-exists-p arch-file-name) - (not (y-or-n-p (concat "File \"" arch-file-name - "\" exists; overwrite? ")))) - (error "ERROR: Creating component...aborted")) - (find-file arch-file-name) - (erase-buffer) - (set-buffer-modified-p nil) - ;; insert header - (if vhdl-compose-include-header - (progn (vhdl-template-header) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n"))) - ;; insert architecture body - (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) - (vhdl-insert-keyword " OF ") (insert ent-name) - (vhdl-insert-keyword " IS\n\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") - (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") - (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") - (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) - (vhdl-insert-keyword "BEGIN") - (when vhdl-self-insert-comments - (insert " -- ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) - (insert arch-name)) - (insert "\n\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") - (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") - (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) - (insert arch-name ";\n\n") - ;; insert footer and save - (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) - (vhdl-template-footer) - (vhdl-comment-display-line) (insert "\n")) - (goto-char (or end-pos (point-min))) - (setq arch-buffer (current-buffer)) - (when ent-buffer (set-buffer ent-buffer) (save-buffer)) - (set-buffer arch-buffer) (save-buffer) - (message "%s" - (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) - (and ent-file-name - (format "\n File created: \"%s\"" ent-file-name)) - (and arch-file-name - (format "\n File created: \"%s\"" arch-file-name)))))) - -(defun vhdl-compose-place-component () - "Place new component by pasting current port as component declaration and -component instantiation." - (interactive) - (if (not vhdl-port-list) - (error "ERROR: No port has been read") - (save-excursion - (vhdl-prepare-search-2 - (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) - (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) - (error "ERROR: No architecture found")) - (let* ((ent-name (match-string 1)) - (ent-file-name - (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) - "." (file-name-extension (buffer-file-name)))) - (orig-buffer (current-buffer))) - (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) - ;; place component declaration - (unless (or vhdl-use-components-package - (vhdl-use-direct-instantiation) - (save-excursion - (re-search-forward - (concat "^\\s-*component\\s-+" - (car vhdl-port-list) "\\>") nil t))) - (re-search-forward "^begin\\>" nil) - (beginning-of-line) - (skip-chars-backward " \t\n\r\f") - (insert "\n\n") (indent-to vhdl-basic-offset) - (vhdl-port-paste-component t)) - ;; place component instantiation - (re-search-forward "^end\\>" nil) - (beginning-of-line) - (skip-chars-backward " \t\n\r\f") - (insert "\n\n") (indent-to vhdl-basic-offset) - (vhdl-port-paste-instance nil t t) - ;; place use clause for used packages - (when (nth 3 vhdl-port-list) - ;; open entity file - (when (file-exists-p ent-file-name) - (find-file ent-file-name)) - (goto-char (point-min)) - (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) - (error "ERROR: Entity not found: \"%s\"" ent-name)) - (goto-char (match-beginning 0)) - (if (and (save-excursion - (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) - (match-string 1)) - (progn (goto-char (match-end 0)) - (beginning-of-line 2)) - (insert "\n") - (backward-char)) - (vhdl-port-paste-context-clause) - (switch-to-buffer orig-buffer)) - (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) - -(defun vhdl-compose-wire-components () - "Connect components." - (interactive) - (save-excursion - (vhdl-prepare-search-2 - (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) - (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) - (error "ERROR: No architecture found")) - (let* ((ent-name (match-string 1)) - (ent-file-name - (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) - "." (file-name-extension (buffer-file-name)))) - (arch-decl-pos (point-marker)) - (arch-stat-pos (re-search-forward "^begin\\>" nil)) - (arch-end-pos (re-search-forward "^end\\>" nil)) - (pack-name (vhdl-get-components-package-name)) - (pack-file-name - (concat (vhdl-replace-string vhdl-package-file-name pack-name t) - "." (file-name-extension (buffer-file-name)))) - inst-name comp-name comp-ent-name comp-ent-file-name has-generic - port-alist generic-alist inst-alist - signal-name signal-entry signal-alist local-list written-list - single-in-list multi-in-list single-out-list multi-out-list - constant-name constant-entry constant-alist single-list multi-list - port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos - generic-beg-pos generic-pos generic-inst-pos generic-end-pos - signal-beg-pos signal-pos - constant-temp-pos port-temp-pos signal-temp-pos) - (message "Wiring components...") - ;; process all instances - (goto-char arch-stat-pos) - (while (re-search-forward - (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" - "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)" - "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|" - "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?" - "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t) - (setq inst-name (match-string-no-properties 1) - comp-name (match-string-no-properties 4) - comp-ent-name (match-string-no-properties 12) - has-generic (or (match-string 7) (match-string 17))) - ;; get port ... - (if comp-name - ;; ... from component declaration - (vhdl-visit-file - (when vhdl-use-components-package pack-file-name) t - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) - (error "ERROR: Component declaration not found: \"%s\"" comp-name)) - (vhdl-port-copy))) - ;; ... from entity declaration (direct instantiation) - (setq comp-ent-file-name - (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) - "." (file-name-extension (buffer-file-name)))) - (vhdl-visit-file - comp-ent-file-name t - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) - (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) - (vhdl-port-copy)))) - (vhdl-port-flatten t) - (setq generic-alist (nth 1 vhdl-port-list) - port-alist (nth 2 vhdl-port-list) - vhdl-port-list nil) - (setq constant-alist nil - signal-alist nil) - (when has-generic - ;; process all constants in generic map - (vhdl-forward-syntactic-ws) - (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) - (setq constant-name (match-string-no-properties 3)) - (setq constant-entry - (cons constant-name - (if (match-string 1) - (or (vhdl-aget generic-alist (match-string 2)) - (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) - (cdar generic-alist)))) - (push constant-entry constant-alist) - (setq constant-name (downcase constant-name)) - (if (or (member constant-name single-list) - (member constant-name multi-list)) - (progn (setq single-list (delete constant-name single-list)) - (vhdl--pushnew constant-name multi-list :test #'equal)) - (vhdl--pushnew constant-name single-list :test #'equal)) - (unless (match-string 1) - (setq generic-alist (cdr generic-alist))) - (vhdl-forward-syntactic-ws)) - (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t)) - ;; process all signals in port map - (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 (vhdl-aget port-alist (match-string 2)) - (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) - (cdar port-alist)))) - (push signal-entry signal-alist) - (setq signal-name (downcase signal-name)) - (if (equal (upcase (nth 2 signal-entry)) "IN") - ;; input signal - (cond - ((member signal-name local-list) - nil) - ((or (member signal-name single-out-list) - (member signal-name multi-out-list)) - (setq single-out-list (delete signal-name single-out-list)) - (setq multi-out-list (delete signal-name multi-out-list)) - (vhdl--pushnew signal-name local-list :test #'equal)) - ((member signal-name single-in-list) - (setq single-in-list (delete signal-name single-in-list)) - (vhdl--pushnew signal-name multi-in-list :test #'equal)) - ((not (member signal-name multi-in-list)) - (vhdl--pushnew signal-name single-in-list :test #'equal))) - ;; output signal - (cond - ((member signal-name local-list) - nil) - ((or (member signal-name single-in-list) - (member signal-name multi-in-list)) - (setq single-in-list (delete signal-name single-in-list)) - (setq multi-in-list (delete signal-name multi-in-list)) - (vhdl--pushnew signal-name local-list :test #'equal)) - ((member signal-name single-out-list) - (setq single-out-list (delete signal-name single-out-list)) - (vhdl--pushnew signal-name multi-out-list :test #'equal)) - ((not (member signal-name multi-out-list)) - (vhdl--pushnew signal-name single-out-list :test #'equal)))) - (unless (match-string 1) - (setq port-alist (cdr port-alist))) - (vhdl-forward-syntactic-ws)) - (push (list inst-name (nreverse constant-alist) - (nreverse signal-alist)) - inst-alist)) - ;; prepare signal insertion - (vhdl-goto-marker arch-decl-pos) - (forward-line 1) - (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t) - (setq signal-pos (point-marker)) - (while (progn (vhdl-forward-syntactic-ws) - (looking-at "signal\\>")) - (beginning-of-line 2) - (delete-region signal-pos (point))) - (setq signal-beg-pos signal-pos) - ;; open entity file - (when (file-exists-p ent-file-name) - (find-file ent-file-name)) - (goto-char (point-min)) - (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) - (error "ERROR: Entity not found: \"%s\"" ent-name)) - ;; prepare generic clause insertion - (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t) - (match-string 1)) - (goto-char (match-beginning 0)) - (indent-to vhdl-basic-offset) - (insert "generic ();\n\n") - (backward-char 4)) - (backward-char) - (setq generic-pos (point-marker)) - (forward-sexp) (end-of-line) - (delete-region generic-pos (point)) (delete-char 1) - (insert "(\n") - (when multi-list - (insert "\n") - (indent-to (* 2 vhdl-basic-offset)) - (insert "-- global generics\n")) - (setq generic-beg-pos (point-marker) generic-pos (point-marker) - generic-inst-pos (point-marker) generic-end-pos (point-marker)) - ;; prepare port clause insertion - (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t) - (match-string 1)) - (goto-char (match-beginning 0)) - (indent-to vhdl-basic-offset) - (insert "port ();\n\n") - (backward-char 4)) - (backward-char) - (setq port-in-pos (point-marker)) - (forward-sexp) (end-of-line) - (delete-region port-in-pos (point)) (delete-char 1) - (insert "(\n") - (when (or multi-in-list multi-out-list) - (insert "\n") - (indent-to (* 2 vhdl-basic-offset)) - (insert "-- global ports\n")) - (setq port-beg-pos (point-marker) port-in-pos (point-marker) - port-out-pos (point-marker) port-inst-pos (point-marker) - port-end-pos (point-marker)) - ;; insert generics, ports and signals - (setq inst-alist (nreverse inst-alist)) - (while inst-alist - (setq inst-name (nth 0 (car inst-alist)) - constant-alist (nth 1 (car inst-alist)) - signal-alist (nth 2 (car inst-alist)) - constant-temp-pos generic-inst-pos - port-temp-pos port-inst-pos - signal-temp-pos signal-pos) - ;; generics - (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) - (vhdl-goto-marker generic-pos) - (setq generic-end-pos - (vhdl-max-marker - generic-end-pos - (vhdl-compose-insert-generic constant-entry))) - (setq generic-pos (point-marker)) - (vhdl--pushnew constant-name written-list :test #'equal)) - (t - (vhdl-goto-marker - (vhdl-max-marker generic-inst-pos generic-pos)) - (setq generic-end-pos - (vhdl-compose-insert-generic constant-entry)) - (setq generic-inst-pos (point-marker)) - (vhdl--pushnew constant-name written-list :test #'equal)))) - (setq constant-alist (cdr constant-alist))) - (when (/= constant-temp-pos generic-inst-pos) - (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) - (insert "\n") (indent-to (* 2 vhdl-basic-offset)) - (insert "-- generics for \"" inst-name "\"\n") - (vhdl-goto-marker generic-inst-pos)) - ;; ports and signals - (while signal-alist - (setq signal-name (downcase (caar signal-alist)) - signal-entry (car signal-alist)) - (cond ((member signal-name written-list) - nil) - ((member signal-name multi-in-list) - (vhdl-goto-marker port-in-pos) - (setq port-end-pos - (vhdl-max-marker - port-end-pos (vhdl-compose-insert-port signal-entry))) - (setq port-in-pos (point-marker)) - (vhdl--pushnew signal-name written-list :test #'equal)) - ((member signal-name multi-out-list) - (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) - (setq port-end-pos - (vhdl-max-marker - port-end-pos (vhdl-compose-insert-port signal-entry))) - (setq port-out-pos (point-marker)) - (vhdl--pushnew signal-name written-list :test #'equal)) - ((or (member signal-name single-in-list) - (member signal-name single-out-list)) - (vhdl-goto-marker - (vhdl-max-marker - port-inst-pos - (vhdl-max-marker port-out-pos port-in-pos))) - (setq port-end-pos (vhdl-compose-insert-port signal-entry)) - (setq port-inst-pos (point-marker)) - (vhdl--pushnew signal-name written-list :test #'equal)) - ((equal (upcase (nth 2 signal-entry)) "OUT") - (vhdl-goto-marker signal-pos) - (vhdl-compose-insert-signal signal-entry) - (setq signal-pos (point-marker)) - (vhdl--pushnew signal-name written-list :test #'equal))) - (setq signal-alist (cdr signal-alist))) - (when (/= port-temp-pos port-inst-pos) - (vhdl-goto-marker - (vhdl-max-marker port-temp-pos - (vhdl-max-marker port-in-pos port-out-pos))) - (insert "\n") (indent-to (* 2 vhdl-basic-offset)) - (insert "-- ports to \"" inst-name "\"\n") - (vhdl-goto-marker port-inst-pos)) - (when (/= signal-temp-pos signal-pos) - (vhdl-goto-marker signal-temp-pos) - (insert "\n") (indent-to vhdl-basic-offset) - (insert "-- outputs of \"" inst-name "\"\n") - (vhdl-goto-marker signal-pos)) - (setq inst-alist (cdr inst-alist))) - ;; finalize generic/port clause - (vhdl-goto-marker generic-end-pos) (backward-char) - (when (= generic-beg-pos generic-end-pos) - (insert "\n") (indent-to (* 2 vhdl-basic-offset)) - (insert ";") (backward-char)) - (insert ")") - (vhdl-goto-marker port-end-pos) (backward-char) - (when (= port-beg-pos port-end-pos) - (insert "\n") (indent-to (* 2 vhdl-basic-offset)) - (insert ";") (backward-char)) - (insert ")") - ;; align everything - (when vhdl-auto-align - (vhdl-goto-marker generic-beg-pos) - (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) - (vhdl-align-region-groups port-beg-pos port-end-pos 1) - (vhdl-goto-marker signal-beg-pos) - (vhdl-align-region-groups signal-beg-pos signal-pos)) - (switch-to-buffer (marker-buffer signal-beg-pos)) - (message "Wiring components...done"))))) - -(defun vhdl-compose-insert-generic (entry) - "Insert ENTRY as generic declaration." - (let (pos) - (indent-to (* 2 vhdl-basic-offset)) - (insert (nth 0 entry) " : " (nth 1 entry)) - (when (nth 2 entry) - (insert " := " (nth 2 entry))) - (insert ";") - (setq pos (point-marker)) - (when (and vhdl-include-port-comments (nth 3 entry)) - (vhdl-comment-insert-inline (nth 3 entry) t)) - (insert "\n") - pos)) - -(defun vhdl-compose-insert-port (entry) - "Insert ENTRY as port declaration." - (let (pos) - (indent-to (* 2 vhdl-basic-offset)) - (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") - (setq pos (point-marker)) - (when (and vhdl-include-port-comments (nth 4 entry)) - (vhdl-comment-insert-inline (nth 4 entry) t)) - (insert "\n") - pos)) - -(defun vhdl-compose-insert-signal (entry) - "Insert ENTRY as signal declaration." - (indent-to vhdl-basic-offset) - (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") - (when (and vhdl-include-port-comments (nth 4 entry)) - (vhdl-comment-insert-inline (nth 4 entry) t)) - (insert "\n")) - -(defvar lazy-lock-minimum-size) - -(defun vhdl-compose-components-package () - "Generate a package containing component declarations for all entities in the -current project/directory." - (interactive) - (vhdl-require-hierarchy-info) - (let* ((project (vhdl-project-p)) - (pack-name (vhdl-get-components-package-name)) - (pack-file-name - (concat (vhdl-replace-string vhdl-package-file-name pack-name t) - "." (file-name-extension (buffer-file-name)))) - (ent-alist (vhdl-aget vhdl-entity-alist - (or project - (abbreviate-file-name default-directory)))) - (lazy-lock-minimum-size 0) - clause-pos component-pos) - (message "Generating components package \"%s\"..." pack-name) - ;; open package file - (when (and (file-exists-p pack-file-name) - (not (y-or-n-p (concat "File \"" pack-file-name - "\" exists; overwrite? ")))) - (error "ERROR: Generating components package...aborted")) - (find-file pack-file-name) - (erase-buffer) - ;; insert header - (if vhdl-compose-include-header - (progn (vhdl-template-header - (concat "Components package (generated by Emacs VHDL Mode " - vhdl-version ")")) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n")) - ;; insert std_logic_1164 package - (vhdl-template-package-std-logic-1164) - (insert "\n") (setq clause-pos (point-marker)) - (insert "\n") (vhdl-comment-display-line) (insert "\n\n") - ;; insert package declaration - (vhdl-insert-keyword "PACKAGE ") (insert pack-name) - (vhdl-insert-keyword " IS\n\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") - (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") - (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") - (indent-to vhdl-basic-offset) - (setq component-pos (point-marker)) - (insert "\n\n") (vhdl-insert-keyword "END ") - (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) - (insert pack-name ";\n\n") - ;; insert footer - (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) - (vhdl-template-footer) - (vhdl-comment-display-line) (insert "\n")) - ;; insert component declarations - (while ent-alist - (vhdl-visit-file (nth 2 (car ent-alist)) nil - (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) - (end-of-line) - (vhdl-port-copy)) - (goto-char component-pos) - (vhdl-port-paste-component t) - (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) - (setq component-pos (point-marker)) - (goto-char clause-pos) - (vhdl-port-paste-context-clause pack-name) - (setq clause-pos (point-marker)) - (setq ent-alist (cdr ent-alist))) - (goto-char (point-min)) - (save-buffer) - (message "Generating components package \"%s\"...done\n File created: \"%s\"" - pack-name pack-file-name))) - -(defun vhdl-compose-configuration-architecture ( _ent-name arch-name - ent-alist-arg conf-alist-arg - inst-alist - &optional insert-conf) - "Generate block configuration for architecture." - (let ((ent-alist ent-alist-arg) - (conf-alist conf-alist-arg) - (margin (current-indentation)) - (beg (line-beginning-position)) - ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key - ;; insert block configuration (for architecture) - (vhdl-insert-keyword "FOR ") (insert arch-name "\n") - (setq margin (+ margin vhdl-basic-offset)) - ;; process all instances - (while inst-alist - (setq inst-entry (car inst-alist)) - ;; is component? - (when (nth 4 inst-entry) - (setq insert-conf t) - (setq inst-path (nth 9 inst-entry)) - ;; skip common path with previous instance - (while (and inst-path (equal (car inst-path) (car inst-prev-path))) - (setq inst-path (cdr inst-path) - inst-prev-path (cdr inst-prev-path))) - ;; insert block configuration end (for previous block/generate) - (while inst-prev-path - (setq margin (- margin vhdl-basic-offset)) - (indent-to margin) - (vhdl-insert-keyword "END FOR;\n") - (setq inst-prev-path (cdr inst-prev-path))) - ;; insert block configuration beginning (for current block/generate) - (indent-to margin) - (while inst-path - (setq margin (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "FOR ") - (insert (car inst-path) "\n") - (indent-to margin) - (setq inst-path (cdr inst-path))) - ;; insert component configuration beginning - (vhdl-insert-keyword "FOR ") - (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") - ;; find subconfiguration - (setq conf-key (nth 7 inst-entry)) - (setq tmp-alist conf-alist) - ;; use first configuration found for instance's entity - (while (and tmp-alist (null conf-key)) - (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 (vhdl-aget conf-alist conf-key)) - ;; insert binding indication ... - ;; ... with subconfiguration (if exists) - (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) - (progn - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "USE CONFIGURATION ") - (insert (vhdl-work-library) "." (nth 0 conf-entry)) - (insert ";\n")) - ;; ... with entity (if exists) - (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry))) - (when ent-entry - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-insert-keyword "USE ENTITY ") - (insert (vhdl-work-library) "." (nth 0 ent-entry)) - ;; insert architecture name (if architecture exists) - (when (nth 3 ent-entry) - (setq arch-name - ;; choose architecture name a) from configuration, - ;; b) from mra, or c) from first architecture - (or (nth 0 (vhdl-aget (nth 3 ent-entry) - (or (nth 6 inst-entry) - (nth 4 ent-entry)))) - (nth 1 (car (nth 3 ent-entry))))) - (insert "(" arch-name ")")) - (insert ";\n") - ;; insert block configuration (for architecture of subcomponent) - (when (and vhdl-compose-configuration-hierarchical - (nth 3 ent-entry)) - (indent-to (+ margin vhdl-basic-offset)) - (vhdl-compose-configuration-architecture - (nth 0 ent-entry) arch-name ent-alist conf-alist - (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name))))))) - ;; insert component configuration end - (indent-to margin) - (vhdl-insert-keyword "END FOR;\n") - (setq inst-prev-path (nth 9 inst-entry))) - (setq inst-alist (cdr inst-alist))) - ;; insert block configuration end (for block/generate) - (while inst-prev-path - (setq margin (- margin vhdl-basic-offset)) - (indent-to margin) - (vhdl-insert-keyword "END FOR;\n") - (setq inst-prev-path (cdr inst-prev-path))) - (indent-to (- margin vhdl-basic-offset)) - ;; insert block configuration end or remove beginning (for architecture) - (if insert-conf - (vhdl-insert-keyword "END FOR;\n") - (delete-region beg (point))))) - -(defun vhdl-compose-configuration (&optional ent-name arch-name) - "Generate configuration declaration." - (interactive) - (vhdl-require-hierarchy-info) - (let ((ent-alist (vhdl-aget vhdl-entity-alist - (or (vhdl-project-p) - (abbreviate-file-name default-directory)))) - (conf-alist (vhdl-aget vhdl-config-alist - (or (vhdl-project-p) - (abbreviate-file-name default-directory)))) - (from-speedbar ent-name) - inst-alist conf-name conf-file-name pos) - (vhdl-prepare-search-2 - ;; get entity and architecture name - (unless ent-name - (save-excursion - (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) - (not (equal "END" (upcase (match-string 1)))) - (setq ent-name (match-string-no-properties 3)) - (setq arch-name (match-string-no-properties 2))) - (error "ERROR: Not within an architecture")))) - (setq conf-name (vhdl-replace-string - vhdl-compose-configuration-name - (concat ent-name " " arch-name))) - (setq inst-alist - (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name))) - (downcase arch-name))))) - (message "Generating configuration \"%s\"..." conf-name) - (if vhdl-compose-configuration-create-file - ;; open configuration file - (progn - (setq conf-file-name - (concat (vhdl-replace-string vhdl-configuration-file-name - conf-name t) - "." (file-name-extension (buffer-file-name)))) - (when (and (file-exists-p conf-file-name) - (not (y-or-n-p (concat "File \"" conf-file-name - "\" exists; overwrite? ")))) - (error "ERROR: Creating configuration...aborted")) - (find-file conf-file-name) - (erase-buffer) - (set-buffer-modified-p nil) - ;; insert header - (if vhdl-compose-include-header - (progn (vhdl-template-header - (concat "Configuration declaration for design \"" - ent-name "(" arch-name ")\"")) - (goto-char (point-max))) - (vhdl-comment-display-line) (insert "\n\n"))) - ;; goto end of architecture - (unless from-speedbar - (re-search-forward "^end\\>" nil) - (end-of-line) (insert "\n\n") - (vhdl-comment-display-line) (insert "\n\n"))) - ;; insert library clause - (setq pos (point)) - (vhdl-template-standard-package (vhdl-work-library) nil) - (when (/= pos (point)) - (insert "\n\n")) - ;; insert configuration - (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) - (vhdl-insert-keyword " OF ") (insert ent-name) - (vhdl-insert-keyword " IS\n") - (indent-to vhdl-basic-offset) - ;; insert block configuration (for architecture) - (vhdl-compose-configuration-architecture - ent-name arch-name ent-alist conf-alist inst-alist t) - (vhdl-insert-keyword "END ") (insert conf-name ";") - (when conf-file-name - ;; insert footer and save - (insert "\n\n") - (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) - (vhdl-template-footer) - (vhdl-comment-display-line) (insert "\n")) - (save-buffer)) - (message "%s" - (concat (format "Generating configuration \"%s\"...done" conf-name) - (and conf-file-name - (format "\n File created: \"%s\"" conf-file-name)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compilation / Makefile generation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (using `compile.el') - -(defvar vhdl-compile-post-command "" - "String appended to compile command after file name.") - -(defun vhdl-makefile-name () - "Return the Makefile name of the current project or the current compiler if -no project is defined." - (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))) - (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) - -(defun vhdl-compile-directory () - "Return the directory where compilation/make should be run." - (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 - (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) - (nth 6 compiler))))) - (file-name-as-directory - (if (file-name-absolute-p directory) - directory - (expand-file-name directory (vhdl-default-directory)))))) - -(defun vhdl-uniquify (in-list) - "Remove duplicate elements from IN-LIST." - (let (out-list) - (while in-list - (vhdl--pushnew (car in-list) out-list :test #'equal) - (setq in-list (cdr in-list))) - out-list)) - -(defun vhdl-set-compiler (name) - "Set current compiler to NAME." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) - (if (assoc name vhdl-compiler-alist) - (progn (setq vhdl-compiler name) - (message "Current compiler: \"%s\"" vhdl-compiler)) - (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Compilation - -(defun vhdl-compile-init () - "Initialize for compilation." - (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) - (while commands-alist - (setq sublist (nth 11 (car commands-alist))) - (unless (or (equal "" (car sublist)) - (assoc (car sublist) regexp-alist)) - (push (list (nth 0 sublist) - (nth 1 sublist) - (nth 2 sublist) - (nth 3 sublist)) - regexp-alist)) - (setq commands-alist (cdr commands-alist))) - (setq compilation-error-regexp-alist - (append compilation-error-regexp-alist (nreverse regexp-alist)))) - ;; `compilation-file-regexp-alist' - (let ((commands-alist vhdl-compiler-alist) - regexp-alist sublist) - ;; matches vhdl-mode file name output - (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) - (while commands-alist - (setq sublist (nth 12 (car commands-alist))) - (unless (or (equal "" (car sublist)) - (assoc (car 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)))))) - -(defvar vhdl-compile-file-name nil - "Name of file to be compiled.") - -(defun vhdl-compile-print-file-name () - "Function called within `compile' to print out file name for compilers that -do not print any file names." - (insert "Compiling \"" vhdl-compile-file-name "\"\n")) - -(defun vhdl-get-compile-options (project compiler file-name - &optional file-options-only) - "Get compiler options. Returning nil means do not compile this file." - (let* ((compiler-options (nth 1 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)) - (case-fold-search nil) - file-options) - (while (and exception-list - (not (string-match (caar exception-list) file-name))) - (setq exception-list (cdr exception-list))) - (if (and exception-list (not (cdar exception-list))) - nil - (if (and file-options-only (not exception-list)) - 'default - (setq file-options (cdar exception-list)) - ;; insert library name in compiler-specific options - (setq compiler-options - (vhdl-replace-string (cons "\\(.*\\)" compiler-options) - work-library)) - ;; insert compiler-specific options in project-specific options - (when project-options - (setq project-options - (vhdl-replace-string - (cons "\\(.*\\)\n\\(.*\\)" project-options) - (concat work-library "\n" compiler-options)))) - ;; insert project-specific options in file-specific options - (when file-options - (setq file-options - (vhdl-replace-string - (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) - (concat work-library "\n" compiler-options "\n" - project-options)))) - ;; return options - (or file-options project-options compiler-options))))) - -(defun vhdl-get-make-options (project compiler) - "Get make options." - (let* ((compiler-options (nth 3 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 - (setq compiler-options - (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) - makefile-name)) - ;; insert compiler-specific options in project-specific options - (when project-options - (setq project-options - (vhdl-replace-string - (cons "\\(.*\\)\n\\(.*\\)" project-options) - (concat makefile-name "\n" compiler-options)))) - ;; return options - (or project-options compiler-options))) - -(defun vhdl-compile () - "Compile current buffer using the VHDL compiler specified in `vhdl-compiler'." - (interactive) - (vhdl-compile-init) - (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) - (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) - (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) - (command (nth 0 compiler)) - (default-directory (vhdl-compile-directory)) - (file-name (if vhdl-compile-absolute-path - (buffer-file-name) - (file-relative-name (buffer-file-name)))) - (options (vhdl-get-compile-options project compiler file-name)) - compilation-process-setup-function) - (unless (file-directory-p default-directory) - (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) - ;; put file name into quotes if it contains spaces - (when (string-match " " file-name) - (setq file-name (concat "\"" file-name "\""))) - ;; print out file name if compiler does not - (setq vhdl-compile-file-name (if vhdl-compile-absolute-path - (buffer-file-name) - (file-relative-name (buffer-file-name)))) - (when (and (= 0 (nth 1 (nth 10 compiler))) - (= 0 (nth 1 (nth 11 compiler)))) - (setq compilation-process-setup-function #'vhdl-compile-print-file-name)) - ;; run compilation - (if options - (when command - (compile (concat command " " options " " file-name - (unless (equal vhdl-compile-post-command "") - (concat " " vhdl-compile-post-command))))) - (vhdl-warning "Your project settings tell me not to compile this file")))) - -(defvar vhdl-make-target "all" - "Default target for `vhdl-make' command.") - -(defun vhdl-make (&optional target) - "Call make command for compilation of all updated source files (requires -`Makefile'). Optional argument TARGET allows you to compile the design -specified by a target." - (interactive) - (setq vhdl-make-target - (or target (read-from-minibuffer "Target: " vhdl-make-target - vhdl-minibuffer-local-map))) - (vhdl-compile-init) - (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)) - (default-directory (vhdl-compile-directory))) - (unless (file-directory-p default-directory) - (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) - ;; run make - (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 (vhdl-aget vhdl-compiler-alist vhdl-compiler) - (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) - (command (nth 4 compiler))) - ;; generate makefile - (if command - (let ((default-directory (vhdl-compile-directory))) - (compile (vhdl-replace-string - (cons "\\(.*\\) \\(.*\\)" command) - (concat (vhdl-makefile-name) " " (vhdl-work-library))))) - (vhdl-generate-makefile-1)))) - -(defun vhdl-get-packages (lib-alist work-library) - "Get packages from LIB-ALIST that belong to WORK-LIBRARY." - (let (pack-list) - (while lib-alist - (when (equal (downcase (caar lib-alist)) (downcase work-library)) - (push (cdar lib-alist) pack-list)) - (setq lib-alist (cdr lib-alist))) - pack-list)) - -(defun vhdl-generate-makefile-1 () - "Generate Makefile for current project or directory." - ;; scan hierarchy if required - (if (vhdl-project-p) - (unless (or (assoc vhdl-project vhdl-file-alist) - (vhdl-load-cache vhdl-project)) - (vhdl-scan-project-contents vhdl-project)) - (let ((directory (abbreviate-file-name default-directory))) - (unless (or (assoc directory vhdl-file-alist) - (vhdl-load-cache directory)) - (vhdl-scan-directory-contents directory)))) - (defvar rule-alist) ; we need it to be dynamically bound - (let* ((directory (abbreviate-file-name (vhdl-default-directory))) - (project (vhdl-project-p)) - (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) - (conf-alist (vhdl-aget vhdl-config-alist (or project directory))) - (pack-alist (vhdl-aget vhdl-package-alist (or project directory))) - (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) - '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" - "\\1.vhd" "\\1_body.vhd" identity))) - (mapping-exist - (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) - (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) - (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) - (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) - (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) - (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) - (adjust-case (nth 5 regexp-list)) - (work-library (downcase (vhdl-work-library))) - (compile-directory (expand-file-name (vhdl-compile-directory) - default-directory)) - (makefile-name (vhdl-makefile-name)) - rule-alist arch-alist inst-alist - target-list depend-list unit-list prim-list second-list subcomp-list - lib-alist lib-body-alist pack-list all-pack-list - ent-key ent-file-name arch-key arch-file-name ent-arch-key - conf-key conf-file-name pack-key pack-file-name - ent-entry arch-entry conf-entry pack-entry inst-entry - pack-body-key pack-body-file-name inst-ent-key inst-conf-key - tmp-key tmp-list rule) - ;; check prerequisites - (unless (file-exists-p compile-directory) - (make-directory compile-directory t)) - (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) - (while ent-alist - (setq ent-entry (car ent-alist) - ent-key (nth 0 ent-entry)) - (when (nth 2 ent-entry) - (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 (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 - (concat ent-key " " work-library)))) - (push (cons ent-key tmp-key) unit-list) - ;; rule target for this entity - (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 - (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 (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 (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 " " - work-library)))) - (setq unit-list - (cons (cons ent-arch-key tmp-key) unit-list)) - (push ent-arch-key second-list) - ;; rule target for this architecture - (push ent-arch-key target-list) - ;; rule dependency for corresponding entity - (push ent-key depend-list) - ;; rule dependencies for contained component instantiations - (while inst-alist - (setq inst-entry (car inst-alist)) - (when (or (null (nth 8 inst-entry)) - (equal (downcase (nth 8 inst-entry)) work-library)) - (setq inst-ent-key (or (nth 7 inst-entry) - (nth 5 inst-entry))) - (setq depend-list (cons inst-ent-key depend-list) - subcomp-list (cons inst-ent-key subcomp-list))) - (setq inst-alist (cdr inst-alist))) - ;; 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 (append all-pack-list pack-list)) - ;; add rule - (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) - (setq arch-alist (cdr arch-alist))) - (push (list ent-key second-list (append subcomp-list all-pack-list)) - prim-list)) - (setq ent-alist (cdr ent-alist))) - (setq ent-alist tmp-list) - ;; rules for all configurations - (setq tmp-list conf-alist) - (while conf-alist - (setq conf-entry (car conf-alist) - conf-key (nth 0 conf-entry) - 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 (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 - (concat conf-key " " work-library)))) - (push (cons conf-key tmp-key) unit-list) - ;; rule target for this configuration - (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))) - ;; rule dependencies for used packages - (setq pack-list (vhdl-get-packages lib-alist work-library)) - (setq depend-list (append depend-list pack-list)) - ;; rule dependencies for contained component configurations - (while inst-alist - (setq inst-entry (car inst-alist)) - (setq inst-ent-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 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 - (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 - (setq tmp-list pack-alist) - (while pack-alist - (setq pack-entry (car pack-alist) - pack-key (nth 0 pack-entry) - pack-body-key nil) - (when (nth 2 pack-entry) - (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 (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 - (concat pack-key " " work-library)))) - (push (cons pack-key tmp-key) unit-list) - ;; rule target for this package - (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 - (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 (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 - (concat pack-key " " work-library)))) - (setq unit-list - (cons (cons pack-body-key tmp-key) unit-list)) - ;; rule target for this package's body - (push pack-body-key target-list) - ;; rule dependency for corresponding package declaration - (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 - (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) - prim-list))) - (setq pack-alist (cdr pack-alist))) - (setq pack-alist tmp-list) - ;; generate Makefile - (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 - (vhdl-replace-string - (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) - compiler-id))) - (makefile-path-name (expand-file-name - makefile-name compile-directory)) - (orig-buffer (current-buffer)) - cell second-list subcomp-list options unit-key unit-name) - ;; sort lists - (setq unit-list (vhdl-sort-alist unit-list)) - (setq prim-list (vhdl-sort-alist prim-list)) - (setq tmp-list rule-alist) - (while tmp-list ; pre-sort rule targets - (setq cell (cdar tmp-list)) - (setcar cell (sort (car cell) #'string<)) - (setq tmp-list (cdr tmp-list))) - (setq rule-alist ; sort by first rule target - (sort rule-alist - (lambda (a b) - (string< (car (cadr a)) (car (cadr b)))))) - ;; open and clear Makefile - (set-buffer (find-file-noselect makefile-path-name t t)) - (erase-buffer) - (insert "# -*- Makefile -*-\n" - "### " (file-name-nondirectory makefile-name) - " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version - "\n") - (if project - (insert "\n# Project : " (nth 0 project)) - (insert "\n# Directory : \"" directory "\"")) - (insert "\n# Platform : " vhdl-compiler - "\n# Generated : " (format-time-string "%Y-%m-%d %T ") - (user-login-name) "\n") - ;; insert compile and option variable settings - (insert "\n\n# Define compilation command and options\n" - "\nCOMPILE = " (nth 0 compiler) - "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) - (if (equal vhdl-compile-post-command "") "" - (concat "\nPOST-COMPILE = " vhdl-compile-post-command)) - "\n") - ;; insert library paths - (setq library-directory - (directory-file-name - (if (file-name-absolute-p library-directory) - library-directory - (file-relative-name - (expand-file-name library-directory directory) - 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 - (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" - "\nALL_UNITS =") - (setq unit-list tmp-list) - (while unit-list - (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") - (setq unit-list (cdr unit-list))) - (insert "\n") - (setq unit-list tmp-list) - ;; insert `make all' rule - (insert "\n\n\n# Rule for compiling entire design\n" - "\n" (nth 0 vhdl-makefile-default-targets) " :" - " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) - " \\\n\t\t$(ALL_UNITS)\n") - ;; insert `make clean' rule - (insert "\n\n# Rule for cleaning entire design\n" - "\n" (nth 1 vhdl-makefile-default-targets) " : " - "\n\t-rm -f $(ALL_UNITS)\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 ")" - (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) " " - (nth 1 vhdl-makefile-default-targets) " " - (nth 2 vhdl-makefile-default-targets) "\n") - ;; insert rule for each library unit - (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") - (while prim-list - (setq second-list (sort (nth 1 (car prim-list)) #'string<)) - (setq subcomp-list - (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<)) - (setq unit-key (caar prim-list) - unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) - (nth 0 (vhdl-aget conf-alist unit-key)) - (nth 0 (vhdl-aget pack-alist unit-key)))) - (insert "\n" unit-key) - (unless (equal unit-key unit-name) - (insert " \\\n" unit-name)) - (insert " :" - " \\\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 - (insert "\n\n# Rules for compiling single library unit files\n") - (while rule-alist - (setq rule (car rule-alist)) - ;; get compiler options for this file - (setq options - (vhdl-get-compile-options project compiler (nth 0 rule) t)) - ;; insert rule if file is supposed to be compiled - (setq target-list (nth 1 rule) - depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<)) - ;; insert targets - (setq tmp-list target-list) - (while target-list - (insert "\n$(UNIT-" work-library "-" (car target-list) ")" - (if (cdr target-list) " \\" " :")) - (setq target-list (cdr target-list))) - (setq target-list tmp-list) - ;; insert file name as first dependency - (insert " \\\n\t\t" (nth 0 rule)) - ;; insert dependencies (except if also target or unit does not exist) - (while depend-list - (when (and (not (member (car depend-list) target-list)) - (assoc (car depend-list) unit-list)) - (insert " \\\n\t\t" - "$(UNIT-" work-library "-" (car depend-list) ")")) - (setq depend-list (cdr depend-list))) - ;; insert compile command - (if options - (insert "\n\t$(COMPILE) " - (if (eq options 'default) "$(OPTIONS)" options) " " - (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 "\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) - (message "Generating makefile \"%s\"...done" makefile-name) - ;; save and close file - (if (file-writable-p makefile-path-name) - (progn (save-buffer) - (kill-buffer (current-buffer)) - (set-buffer orig-buffer) - (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))) - (switch-to-buffer (current-buffer)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Bug reports -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (using `reporter.el') - -(defconst vhdl-mode-help-address - "Reto Zimmermann <reto@gnu.org>" - "Address for VHDL Mode bug reports.") - -(defun vhdl-submit-bug-report () - "Submit via mail a bug report on VHDL Mode." - (interactive) - ;; load in reporter - (defvar reporter-prompt-for-summary-p) - (and - (y-or-n-p "Do you want to submit a report on VHDL Mode? ") - (let ((reporter-prompt-for-summary-p t)) - (reporter-submit-bug-report - vhdl-mode-help-address - (concat "VHDL Mode " vhdl-version) - (list - ;; report all important user options - 'vhdl-offsets-alist - 'vhdl-comment-only-line-offset - 'tab-width - 'vhdl-electric-mode - 'vhdl-stutter-mode - 'vhdl-indent-tabs-mode - 'vhdl-project-alist - 'vhdl-project - 'vhdl-project-file-name - 'vhdl-project-autoload - 'vhdl-project-sort - 'vhdl-compiler-alist - 'vhdl-compiler - 'vhdl-compile-use-local-error-regexp - 'vhdl-makefile-default-targets - 'vhdl-makefile-generation-hook - 'vhdl-default-library - 'vhdl-standard - 'vhdl-basic-offset - 'vhdl-upper-case-keywords - 'vhdl-upper-case-types - 'vhdl-upper-case-attributes - 'vhdl-upper-case-enum-values - 'vhdl-upper-case-constants - 'vhdl-use-direct-instantiation - 'vhdl-array-index-record-field-in-sensitivity-list - 'vhdl-compose-configuration-name - 'vhdl-entity-file-name - 'vhdl-architecture-file-name - 'vhdl-configuration-file-name - 'vhdl-package-file-name - 'vhdl-file-name-case - 'vhdl-electric-keywords - 'vhdl-optional-labels - 'vhdl-insert-empty-lines - 'vhdl-argument-list-indent - 'vhdl-association-list-with-formals - 'vhdl-conditions-in-parenthesis - 'vhdl-sensitivity-list-all - 'vhdl-zero-string - 'vhdl-one-string - 'vhdl-file-header - 'vhdl-file-footer - 'vhdl-company-name - 'vhdl-copyright-string - 'vhdl-platform-spec - 'vhdl-date-format - 'vhdl-modify-date-prefix-string - 'vhdl-modify-date-on-saving - 'vhdl-reset-kind - 'vhdl-reset-active-high - 'vhdl-clock-rising-edge - 'vhdl-clock-edge-condition - 'vhdl-clock-name - 'vhdl-reset-name - 'vhdl-model-alist - 'vhdl-include-port-comments - '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 - 'vhdl-testbench-architecture-name - 'vhdl-testbench-configuration-name - 'vhdl-testbench-dut-name - 'vhdl-testbench-include-header - 'vhdl-testbench-declarations - 'vhdl-testbench-statements - 'vhdl-testbench-initialize-signals - 'vhdl-testbench-include-library - 'vhdl-testbench-include-configuration - 'vhdl-testbench-create-files - 'vhdl-testbench-entity-file-name - 'vhdl-testbench-architecture-file-name - 'vhdl-compose-create-files - 'vhdl-compose-configuration-create-file - 'vhdl-compose-configuration-hierarchical - 'vhdl-compose-configuration-use-subconfiguration - 'vhdl-compose-include-header - 'vhdl-compose-architecture-name - 'vhdl-components-package-name - 'vhdl-use-components-package - 'vhdl-self-insert-comments - 'vhdl-prompt-for-comments - 'vhdl-inline-comment-column - 'vhdl-end-comment-column - 'vhdl-auto-align - 'vhdl-align-groups - 'vhdl-align-group-separate - 'vhdl-align-same-indent - 'vhdl-highlight-keywords - 'vhdl-highlight-names - 'vhdl-highlight-special-words - 'vhdl-highlight-forbidden-words - 'vhdl-highlight-verilog-keywords - 'vhdl-highlight-translate-off - 'vhdl-highlight-case-sensitive - 'vhdl-special-syntax-alist - 'vhdl-forbidden-words - 'vhdl-forbidden-syntax - 'vhdl-directive-keywords - 'vhdl-speedbar-auto-open - 'vhdl-speedbar-display-mode - 'vhdl-speedbar-scan-limit - 'vhdl-speedbar-jump-to-unit - 'vhdl-speedbar-update-on-saving - 'vhdl-speedbar-save-cache - 'vhdl-speedbar-cache-file-name - 'vhdl-index-menu - 'vhdl-source-file-menu - 'vhdl-hideshow-menu - 'vhdl-hide-all-init - 'vhdl-print-two-column - 'vhdl-print-customize-faces - 'vhdl-intelligent-tab - 'vhdl-indent-syntax-based - 'vhdl-indent-comment-like-next-code-line - 'vhdl-word-completion-case-sensitive - 'vhdl-word-completion-in-minibuffer - 'vhdl-underscore-is-part-of-word - 'vhdl-mode-hook) - (lambda () - (insert - (if vhdl-special-indent-hook - (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" - "vhdl-special-indent-hook is set to '" - (format "%s" vhdl-special-indent-hook) - ".\nPerhaps this is your problem?\n" - "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") - "\n"))) - nil - "Hi Reto,")))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst vhdl-doc-release-notes nil - "\ -Release Notes for VHDL Mode 3.37 -================================ - -- Added support for VHDL'08: - - New keywords, types, functions, attributes, operators, packages - - Context declaration - - Block comments - - Directives - - `all' keyword in sensitivity list - - -Release Notes for VHDL Mode 3.34 -================================ - -- 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 ------------- - -CONFIGURATION DECLARATION GENERATION: - - Automatic generation of a configuration declaration for a design. - (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) - - -Key Bindings ------------- - -For Emacs compliance the following key bindings have been changed: - -- `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region' -- `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer' -- `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer' -- `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...' - - -User Options ------------- - -`vhdl-configuration-file-name': (new) - Specify how the configuration file name is obtained. -`vhdl-compose-configuration-name': (new) - Specify how the configuration name is obtained. -`vhdl-compose-configuration-create-file': (new) - Specify whether a new file should be created for a configuration. -`vhdl-compose-configuration-hierarchical': (new) - Specify whether hierarchical configurations should be created. -`vhdl-compose-configuration-use-subconfiguration': (new) - Specify whether subconfigurations should be used inside configurations. -`vhdl-makefile-default-targets': (new) - Customize names of Makefile default targets. -`vhdl-indent-comment-like-next-code-line': (new) - Specify whether comment lines are indented like following code line. -`vhdl-array-index-record-field-in-sensitivity-list': (new) - Specify whether to include array indices / record fields in sensitivity list.") - - -(defconst vhdl-doc-keywords nil - "\ -Reserved words in VHDL ----------------------- - -VHDL'08 (IEEE Std 1076-2008): - `vhdl-08-keywords' : keywords - `vhdl-08-types' : standardized types - `vhdl-08-attributes' : standardized attributes - `vhdl-08-functions' : standardized functions - `vhdl-08-packages' : standardized packages and libraries - -VHDL'93/02 (IEEE Std 1076-1993/2002): - `vhdl-02-keywords' : keywords - `vhdl-02-types' : standardized types - `vhdl-02-attributes' : standardized attributes - `vhdl-02-enum-values' : standardized enumeration values - `vhdl-02-functions' : standardized functions - `vhdl-02-packages' : standardized packages and libraries - -VHDL-AMS (IEEE Std 1076.1 / 1076.1.1): - `vhdl-ams-keywords' : keywords - `vhdl-ams-types' : standardized types - `vhdl-ams-attributes' : standardized attributes - `vhdl-ams-enum-values' : standardized enumeration values - `vhdl-ams-constants' : standardized constants - `vhdl-ams-functions' : standardized functions - -Math Packages (IEEE Std 1076.2): - `vhdl-math-types' : standardized types - `vhdl-math-constants' : standardized constants - `vhdl-math-functions' : standardized functions - `vhdl-math-packages' : standardized packages - -Forbidden words: - `vhdl-verilog-keywords' : Verilog reserved words - -NOTE: click `mouse-2' on variable names above (not in XEmacs).") - - -(defconst vhdl-doc-coding-style nil - "\ -For VHDL coding style and naming convention guidelines, see the following -references: - -[1] Ben Cohen. - \"VHDL Coding Styles and Methodologies\". - Kluwer Academic Publishers, 1999. - http://members.aol.com/vhdlcohen/vhdl/ - -[2] Michael Keating and Pierre Bricaud. - \"Reuse Methodology Manual, Second Edition\". - Kluwer Academic Publishers, 1999. - http://www.openmore.com/openmore/rmm2.html - -[3] European Space Agency. - \"VHDL Modelling Guidelines\". - https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf - -Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' -to visually support naming conventions.") - - -(defun vhdl-version () - "Echo the current version of VHDL Mode in the minibuffer." - (interactive) - (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) - (vhdl-keep-region-active)) - -(defun vhdl-doc-variable (variable) - "Display VARIABLE's documentation in *Help* buffer." - (interactive) - (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)) - (with-current-buffer standard-output - (help-mode)) - (help-print-return-message))) - -(defun vhdl-doc-mode () - "Display VHDL Mode documentation in *Help* buffer." - (interactive) - (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) - (princ " mode:\n") - (princ (documentation 'vhdl-mode)) - (with-current-buffer standard-output - (help-mode)) - (help-print-return-message))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(provide 'vhdl-mode) - -;;; vhdl-mode.el ends here -- 2.39.5