72
|
1 ;;; vhdl-mode.el --- major mode for editing VHDL code
|
|
2
|
|
3 ;; Copyright (C) 1994, 1995 Rodney J. Whitby
|
|
4 ;; Copyright (C) 1992, 1993, 1994 Barry A. Warsaw
|
|
5 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
6
|
|
7 ;; Author: Rodney J. Whitby <rwhitby@asc.corp.mot.com>
|
|
8 ;; Maintainer: Rodney J. Whitby <rwhitby@asc.corp.mot.com>
|
|
9 ;; Created: June 1994, adapted from cc-mode.el 4.29 by Barry A. Warsaw.
|
161
|
10 ;; Version: $Revision: 1.5 $
|
|
11 ;; Last Modified: $Date: 1997/06/14 20:31:18 $
|
72
|
12 ;; Keywords: languages VHDL
|
|
13 ;; Archive: ftp.eda.com.au:/pub/emacs/vhdl-mode.tar.gz
|
|
14
|
|
15 ;; NOTE: Read the commentary below for the right way to submit bug reports!
|
|
16
|
|
17 ;; This file is not yet part of GNU Emacs.
|
|
18
|
|
19 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
20 ;; it under the terms of the GNU General Public License as published by
|
|
21 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
22 ;; any later version.
|
|
23
|
|
24 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
25 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
26 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
27 ;; GNU General Public License for more details.
|
|
28
|
|
29 ;; You should have received a copy of the GNU General Public License
|
|
30 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
31 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
32
|
|
33 ;;; Commentary:
|
|
34
|
|
35 ;; This package provides indentation support for VHDL code.
|
|
36
|
|
37 ;; Details on VHDL-MODE are now contained in an accompanying texinfo
|
|
38 ;; manual (vhdl-mode.texi).
|
|
39
|
|
40 ;; To submit bug reports, hit "C-c C-b", and please try to include a
|
|
41 ;; code sample so I can reproduce your problem. If you have other
|
|
42 ;; questions contact me at the address listed at the top of this file.
|
|
43
|
|
44 ;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of
|
|
45 ;; the multi-Emacsen support. FSF Emacs 19 and XEmacs 19 (formerly
|
|
46 ;; Lucid) do things differently and there's no way to shut the
|
|
47 ;; byte-compiler up at the necessary granularity. Let me say this
|
|
48 ;; again: YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS (you'd be
|
|
49 ;; surprised at how many people don't follow this advice :-).
|
|
50
|
|
51 ;; To use VHDL-MODE, add the following to your .emacs file. This
|
|
52 ;; assumes you will use .vhd extensions for your VHDL source:
|
|
53 ;;
|
|
54 ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Editing Mode" t)
|
|
55 ;; (setq auto-mode-alist
|
|
56 ;; (append '(("\\.vhd$" . vhdl-mode) ; to edit VHDL code
|
|
57 ;; ) auto-mode-alist))
|
|
58 ;;
|
|
59 ;; If you would like to join the `vhdl-mode-announce' announcements
|
|
60 ;; list or the `vhdl-mode-victims' beta testers list, send add/drop
|
|
61 ;; requests to the address listed at the top of this file.
|
|
62 ;;
|
|
63 ;; Many, many thanks go out to all the folks on the beta test list.
|
|
64 ;; Without their patience, testing, insight, and code contributions,
|
|
65 ;; and encouragement vhdl-mode.el would be a far inferior package.
|
|
66 ;; Special thanks to Ken Wood <ken@eda.com.au> for providing an FTP
|
|
67 ;; repository for vhdl-mode.
|
|
68
|
|
69 ;; LCD Archive Entry:
|
|
70 ;; vhdl-mode.el|Rodney J. Whitby|rwhitby@asc.corp.mot.com
|
|
71 ;; |Major mode for editing VHDL code
|
161
|
72 ;; |$Date: 1997/06/14 20:31:18 $|$Revision: 1.5 $
|
72
|
73 ;; |ftp.eda.com.au:/pub/emacs/vhdl-mode.tar.gz
|
|
74
|
|
75
|
|
76 ;;; Code:
|
|
77
|
|
78 ;; user definable variables
|
|
79 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
|
|
80
|
|
81 (defvar vhdl-inhibit-startup-warnings-p nil
|
|
82 "*If non-nil, inhibits start up compatibility warnings.")
|
|
83 (defvar vhdl-strict-syntax-p nil
|
|
84 "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
|
|
85 If the syntactic symbol for a particular line does not match a symbol
|
|
86 in the offsets alist, an error is generated, otherwise no error is
|
|
87 reported and the syntactic symbol is ignored.")
|
|
88 (defvar vhdl-echo-syntactic-information-p nil
|
|
89 "*If non-nil, syntactic info is echoed when the line is indented.")
|
|
90 (defvar vhdl-basic-offset 2
|
|
91 "*Amount of basic offset used by + and - symbols in `vhdl-offsets-alist'.")
|
|
92
|
|
93 (defconst vhdl-offsets-alist-default
|
|
94 '((string . -1000)
|
|
95 (block-open . 0)
|
|
96 (block-close . 0)
|
|
97 (statement . 0)
|
|
98 (statement-cont . vhdl-lineup-statement-cont)
|
|
99 (statement-block-intro . +)
|
|
100 (statement-case-intro . +)
|
|
101 (case-alternative . +)
|
|
102 (comment . vhdl-lineup-comment)
|
|
103 (arglist-intro . vhdl-lineup-arglist-intro)
|
|
104 (arglist-cont . 0)
|
|
105 (arglist-cont-nonempty . vhdl-lineup-arglist)
|
|
106 (arglist-close . vhdl-lineup-arglist)
|
|
107 (entity . 0)
|
|
108 (configuration . 0)
|
|
109 (package . 0)
|
|
110 (architecture . 0)
|
|
111 (package-body . 0)
|
|
112 )
|
|
113 "Default settings for offsets of syntactic elements.
|
|
114 Do not change this constant! See the variable `vhdl-offsets-alist' for
|
|
115 more information.")
|
|
116
|
|
117 (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
|
|
118 "*Association list of syntactic element symbols and indentation offsets.
|
|
119 As described below, each cons cell in this list has the form:
|
|
120
|
|
121 (SYNTACTIC-SYMBOL . OFFSET)
|
|
122
|
|
123 When a line is indented, vhdl-mode first determines the syntactic
|
|
124 context of the line by generating a list of symbols called syntactic
|
|
125 elements. This list can contain more than one syntactic element and
|
|
126 the global variable `vhdl-syntactic-context' contains the context list
|
|
127 for the line being indented. Each element in this list is actually a
|
|
128 cons cell of the syntactic symbol and a buffer position. This buffer
|
|
129 position is call the relative indent point for the line. Some
|
|
130 syntactic symbols may not have a relative indent point associated with
|
|
131 them.
|
|
132
|
|
133 After the syntactic context list for a line is generated, vhdl-mode
|
|
134 calculates the absolute indentation for the line by looking at each
|
|
135 syntactic element in the list. First, it compares the syntactic
|
|
136 element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it
|
|
137 finds a match, it adds the OFFSET to the column of the relative indent
|
|
138 point. The sum of this calculation for each element in the syntactic
|
|
139 list is the absolute offset for line being indented.
|
|
140
|
|
141 If the syntactic element does not match any in the `vhdl-offsets-alist',
|
|
142 an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
|
|
143 the element is ignored.
|
|
144
|
|
145 Actually, OFFSET can be an integer, a function, a variable, or one of
|
|
146 the following symbols: `+', `-', `++', or `--'. These latter
|
|
147 designate positive or negative multiples of `vhdl-basic-offset',
|
|
148 respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is
|
|
149 called with a single argument containing the cons of the syntactic
|
|
150 element symbol and the relative indent point. The function should
|
|
151 return an integer offset.
|
|
152
|
|
153 Here is the current list of valid syntactic element symbols:
|
|
154
|
|
155 string -- inside multi-line string
|
|
156 block-open -- statement block open
|
|
157 block-close -- statement block close
|
|
158 statement -- a VHDL statement
|
|
159 statement-cont -- a continuation of a VHDL statement
|
|
160 statement-block-intro -- the first line in a new statement block
|
|
161 statement-case-intro -- the first line in a case alternative block
|
|
162 case-alternative -- a case statement alternative clause
|
|
163 comment -- a line containing only a comment
|
|
164 arglist-intro -- the first line in an argument list
|
|
165 arglist-cont -- subsequent argument list lines when no
|
|
166 arguments follow on the same line as the
|
|
167 the arglist opening paren
|
|
168 arglist-cont-nonempty -- subsequent argument list lines when at
|
|
169 least one argument follows on the same
|
|
170 line as the arglist opening paren
|
|
171 arglist-close -- the solo close paren of an argument list
|
|
172 entity -- inside an entity declaration
|
|
173 configuration -- inside a configuration declaration
|
|
174 package -- inside a package declaration
|
|
175 architecture -- inside an architecture body
|
|
176 package-body -- inside a package body
|
|
177 ")
|
|
178
|
|
179 (defvar vhdl-tab-always-indent t
|
|
180 "*Controls the operation of the TAB key.
|
|
181 If t, hitting TAB always just indents the current line. If nil,
|
|
182 hitting TAB indents the current line if point is at the left margin or
|
|
183 in the line's indentation, otherwise it insert a real tab character.
|
|
184 If other than nil or t, then tab is inserted only within literals
|
|
185 -- defined as comments and strings -- and inside preprocessor
|
|
186 directives, but line is always reindented.
|
|
187
|
|
188 Note that indentation of lines containing only comments is also
|
|
189 controlled by the `vhdl-comment-only-line-offset' variable.")
|
|
190
|
|
191 (defvar vhdl-comment-only-line-offset 0
|
|
192 "*Extra offset for line which contains only the start of a comment.
|
|
193 Can contain an integer or a cons cell of the form:
|
|
194
|
|
195 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
|
|
196
|
|
197 Where NON-ANCHORED-OFFSET is the amount of offset given to
|
|
198 non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
|
|
199 the amount of offset to give column-zero anchored comment-only lines.
|
|
200 Just an integer as value is equivalent to (<val> . 0)")
|
|
201
|
|
202 (defvar vhdl-special-indent-hook nil
|
|
203 "*Hook for user defined special indentation adjustments.
|
|
204 This hook gets called after a line is indented by the mode.")
|
|
205
|
|
206 (defvar vhdl-style-alist
|
|
207 '(("IEEE"
|
|
208 (vhdl-basic-offset . 4)
|
|
209 (vhdl-offsets-alist . ())
|
|
210 )
|
|
211 )
|
|
212 "Styles of Indentation.
|
|
213 Elements of this alist are of the form:
|
|
214
|
|
215 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
|
|
216
|
|
217 where STYLE-STRING is a short descriptive string used to select a
|
|
218 style, VARIABLE is any vhdl-mode variable, and VALUE is the intended
|
|
219 value for that variable when using the selected style.
|
|
220
|
|
221 There is one special case when VARIABLE is `vhdl-offsets-alist'. In this
|
|
222 case, the VALUE is a list containing elements of the form:
|
|
223
|
|
224 (SYNTACTIC-SYMBOL . VALUE)
|
|
225
|
|
226 as described in `vhdl-offsets-alist'. These are passed directly to
|
|
227 `vhdl-set-offset' so there is no need to set every syntactic symbol in
|
|
228 your style, only those that are different from the default.")
|
|
229
|
|
230 ;; dynamically append the default value of most variables
|
|
231 (or (assoc "Default" vhdl-style-alist)
|
|
232 (let* ((varlist '(vhdl-inhibit-startup-warnings-p
|
|
233 vhdl-strict-syntax-p
|
|
234 vhdl-echo-syntactic-information-p
|
|
235 vhdl-basic-offset
|
|
236 vhdl-offsets-alist
|
|
237 vhdl-tab-always-indent
|
|
238 vhdl-comment-only-line-offset))
|
|
239 (default (cons "Default"
|
|
240 (mapcar
|
|
241 (function
|
|
242 (lambda (var)
|
|
243 (cons var (symbol-value var))
|
|
244 ))
|
|
245 varlist))))
|
|
246 (setq vhdl-style-alist (cons default vhdl-style-alist))))
|
|
247
|
|
248 (defvar vhdl-mode-hook nil
|
|
249 "*Hook called by `vhdl-mode'.")
|
|
250
|
|
251 (defvar vhdl-mode-menu
|
|
252 '(["Comment Out Region" comment-region (mark)]
|
|
253 ;; ["Indent Expression" vhdl-indent-exp
|
|
254 ;; (memq (following-char) '(?\( ?\[ ?\{))]
|
|
255 ["Indent Line" vhdl-indent-command t]
|
|
256 ["Backward Statement" vhdl-beginning-of-statement t]
|
|
257 ;; ["Forward Statement" vhdl-end-of-statement t]
|
|
258 )
|
|
259 "XEmacs 19 (formerly Lucid) menu for VHDL mode.")
|
|
260
|
|
261 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
|
262 ;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT
|
|
263
|
|
264
|
|
265 ;; Emacs variant handling, and standard mode variables and functions:
|
|
266
|
|
267 (defconst vhdl-emacs-features
|
|
268 (let ((major (and (boundp 'emacs-major-version)
|
|
269 emacs-major-version))
|
|
270 (minor (and (boundp 'emacs-minor-version)
|
|
271 emacs-minor-version))
|
|
272 flavor)
|
|
273 ;; figure out version numbers if not already discovered
|
|
274 (and (or (not major) (not minor))
|
|
275 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
|
|
276 (setq major (string-to-int (substring emacs-version
|
|
277 (match-beginning 1)
|
|
278 (match-end 1)))
|
|
279 minor (string-to-int (substring emacs-version
|
|
280 (match-beginning 2)
|
|
281 (match-end 2)))))
|
|
282 (if (not (and major minor))
|
|
283 (error "Cannot figure out the major and minor version numbers."))
|
|
284 ;; calculate the major version
|
|
285 (cond
|
|
286 ((= major 18) (setq major 'v18)) ;Emacs 18
|
|
287 ((= major 4) (setq major 'v18)) ;Epoch 4
|
155
|
288 ((>= major 19) (setq major 'v19 ;Emacs 19
|
72
|
289 flavor (cond
|
|
290 ((string-match "Win-Emacs" emacs-version)
|
|
291 'Win-Emacs)
|
|
292 ((or (string-match "Lucid" emacs-version)
|
|
293 (string-match "XEmacs" emacs-version))
|
|
294 'XEmacs)
|
|
295 (t
|
|
296 'FSF))))
|
|
297 ;; I don't know
|
|
298 (t (error "Cannot recognize major version number: %s" major)))
|
|
299 ;; lets do some minimal sanity checking.
|
|
300 (if (and (or
|
|
301 ;; Emacs 18 is brain dead
|
|
302 (eq major 'v18)
|
|
303 ;; Lemacs before 19.6 had bugs
|
|
304 (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
|
|
305 ;; FSF 19 before 19.21 had bugs
|
|
306 (and (eq major 'v19) (eq flavor 'FSF) (< minor 21)))
|
|
307 (not vhdl-inhibit-startup-warnings-p))
|
|
308 (with-output-to-temp-buffer "*vhdl-mode warnings*"
|
|
309 (print (format
|
|
310 "The version of Emacs that you are running, %s,
|
|
311 has known bugs in its syntax.c parsing routines which will affect the
|
|
312 performance of vhdl-mode. You should strongly consider upgrading to the
|
|
313 latest available version. vhdl-mode may continue to work, after a
|
|
314 fashion, but strange indentation errors could be encountered."
|
|
315 emacs-version))))
|
|
316 (list major flavor))
|
|
317 "A list of features extant in the Emacs you are using.
|
|
318 There are many flavors of Emacs out there, each with different
|
|
319 features supporting those needed by vhdl-mode. Here's the current
|
|
320 supported list, along with the values for this variable:
|
|
321
|
|
322 Emacs 18/Epoch 4: (v18)
|
|
323 XEmacs (formerly Lucid) 19: (v19 XEmacs)
|
|
324 Win-Emacs 1.35: (V19 Win-Emacs)
|
|
325 FSF Emacs 19: (v19 FSF).")
|
|
326
|
|
327 (defvar vhdl-mode-abbrev-table nil
|
|
328 "Abbrev table in use in vhdl-mode buffers.")
|
|
329 (define-abbrev-table 'vhdl-mode-abbrev-table ())
|
|
330
|
|
331 (defvar vhdl-mode-map ()
|
|
332 "Keymap used in vhdl-mode buffers.")
|
|
333 (if vhdl-mode-map
|
|
334 ()
|
|
335 ;; TBD: should we even worry about naming this keymap. My vote: no,
|
|
336 ;; because FSF and XEmacs (formerly Lucid) do it differently.
|
|
337 (setq vhdl-mode-map (make-sparse-keymap))
|
|
338 ;; put standard keybindings into MAP
|
|
339 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement)
|
|
340 ;;(define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement)
|
|
341 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp)
|
|
342 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp)
|
|
343 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
|
|
344 ;;(define-key vhdl-mode-map "\M-\C-d" 'vhdl-down-list)
|
|
345 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-beginning-of-defun)
|
|
346 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-end-of-defun)
|
|
347 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)
|
|
348 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
|
|
349 (define-key vhdl-mode-map "\t" 'vhdl-indent-command)
|
|
350 ;; these are new keybindings, with no counterpart to BOCM
|
|
351 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-submit-bug-report)
|
|
352 (define-key vhdl-mode-map "\C-c\C-c" 'comment-region)
|
|
353 (define-key vhdl-mode-map "\C-c\C-o" 'vhdl-set-offset)
|
|
354 (define-key vhdl-mode-map "\C-c\C-r" 'vhdl-regress-line)
|
|
355 (define-key vhdl-mode-map "\C-c\C-s" 'vhdl-show-syntactic-information)
|
|
356 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
|
|
357 ;; in XEmacs (formerly Lucid) 19, we want the menu to popup when
|
|
358 ;; the 3rd button is hit. In 19.10 and beyond this is done
|
|
359 ;; automatically if we put the menu on mode-popup-menu variable,
|
|
360 ;; see c-common-init. RMS decided that this feature should not be
|
|
361 ;; included for FSF's Emacs.
|
|
362 (if (and (boundp 'current-menubar)
|
|
363 (not (boundp 'mode-popup-menu)))
|
|
364 (define-key vhdl-mode-map 'button3 'vhdl-popup-menu))
|
|
365 )
|
|
366
|
|
367 (defvar vhdl-mode-syntax-table nil
|
|
368 "Syntax table used in vhdl-mode buffers.")
|
|
369 (if vhdl-mode-syntax-table
|
|
370 ()
|
|
371 (setq vhdl-mode-syntax-table (make-syntax-table))
|
|
372 ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
|
|
373 (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table)
|
|
374 (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table)
|
|
375 (modify-syntax-entry ?\% "." vhdl-mode-syntax-table)
|
|
376 (modify-syntax-entry ?\& "." vhdl-mode-syntax-table)
|
|
377 (modify-syntax-entry ?\' "." vhdl-mode-syntax-table)
|
|
378 (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table)
|
|
379 (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table)
|
|
380 (modify-syntax-entry ?\* "." vhdl-mode-syntax-table)
|
|
381 (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table)
|
|
382 (modify-syntax-entry ?\. "." vhdl-mode-syntax-table)
|
|
383 (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table)
|
|
384 (modify-syntax-entry ?\: "." vhdl-mode-syntax-table)
|
|
385 (modify-syntax-entry ?\; "." vhdl-mode-syntax-table)
|
|
386 (modify-syntax-entry ?\< "." vhdl-mode-syntax-table)
|
|
387 (modify-syntax-entry ?\= "." vhdl-mode-syntax-table)
|
|
388 (modify-syntax-entry ?\> "." vhdl-mode-syntax-table)
|
|
389 (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table)
|
|
390 (modify-syntax-entry ?\\ "\\" vhdl-mode-syntax-table)
|
|
391 (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table)
|
|
392 (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table)
|
|
393 (modify-syntax-entry ?\| "." vhdl-mode-syntax-table)
|
|
394 (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table)
|
|
395 ;; add comment syntax
|
|
396 (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)
|
|
397 (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table)
|
|
398 (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table))
|
|
399
|
|
400 (defvar vhdl-syntactic-context nil
|
|
401 "Buffer local variable containing syntactic analysis list.")
|
|
402 (make-variable-buffer-local 'vhdl-syntactic-context)
|
|
403
|
|
404 ;; Support for outline modes
|
|
405
|
|
406 (defconst vhdl-outline-regexp
|
|
407 (concat "\\(entity\\)\\|\\(package\\)\\|"
|
|
408 "\\( *procedure\\)\\|\\( *function\\)\\|"
|
|
409 "\\( *component\\)\\|\\(architecture\\)\\|"
|
|
410 "\\(package body\\)\\|\\( *[A-Za-z][A-Za-z0-9_]* : block\\)\\|"
|
|
411 "\\( *[A-Za-z][A-Za-z0-9_]* : process\\)\\|\\(configuration\\)"))
|
|
412
|
|
413 (defun vhdl-outline-level () ; was copied from c-outline-level
|
|
414 (save-excursion
|
|
415 (skip-chars-forward "\t ")
|
|
416 (current-column)))
|
|
417
|
|
418 ;; Support for font-lock
|
|
419
|
|
420 (defconst vhdl-font-lock-keywords-1
|
|
421 (purecopy
|
|
422 (list
|
|
423 ;; Highlight names of common constructs
|
|
424 (list
|
|
425 (concat
|
|
426 "^[ \t]*\\(entity\\|architecture\\|configuration\\|function\\|"
|
|
427 "procedure\\|component\\|package[ \t]+body\\|package\\|"
|
|
428 "end[ \t]+\\(block\\|process\\|case\\|generate\\|loop\\)\\)[ \t]+"
|
|
429 "\\(\\(\\w\\|\\s_\\)+\\)")
|
|
430 3 'font-lock-function-name-face)
|
|
431
|
|
432 ;; Highlight labels of common constructs
|
|
433 (list
|
|
434 (concat
|
|
435 "^[ \t]*\\(\\(\\w\\|\\s_\\)+\\)[ \t]*:[ \t\n]*\\(block\\|process\\|"
|
|
436 "if\\|for\\|case\\|exit\\|loop\\|next\\|null\\|with\\|"
|
|
437 "\\(\\w\\|\\s_\\)+[ \t\n]+port[ \t]+map\\)\\>[^_]")
|
|
438 1 'font-lock-function-name-face)
|
|
439
|
|
440 ;; Highlight OF labels
|
|
441 (list
|
|
442 (concat
|
|
443 "^[ \t]*\\(configuration\\|architecture\\|attribute\\)[ \t]+"
|
|
444 "\\(\\(\\w\\|\\s_\\)+\\)[ \t]+of[ \t]+\\(\\(\\w\\|\\s_\\)+\\)")
|
|
445 4 'font-lock-function-name-face)
|
|
446
|
|
447 ;; Fontify library useage clauses.
|
|
448 (list
|
|
449 (concat
|
|
450 "[^\\s_]\\<\\(library\\|use\\)[ \t\n]+\\(entity[ \t\n]+\\)?"
|
|
451 "\\(\\(\\w\\|\\s_\\|[\.()]\\)+\\)")
|
|
452 3 'font-lock-function-name-face)
|
|
453 ))
|
|
454 "For consideration as a value of `vhdl-font-lock-keywords'.
|
|
455 This does fairly subdued highlighting of function names.")
|
|
456
|
|
457 (defconst vhdl-font-lock-keywords-2
|
|
458 (purecopy
|
|
459 (append
|
|
460 vhdl-font-lock-keywords-1
|
|
461 (list
|
|
462 (list
|
|
463 (concat
|
|
464 "[^\\s_]\\<\\("
|
|
465 (mapconcat
|
|
466 'identity
|
|
467 '(
|
|
468 ;; the following is a list of all reserved words known in VHDL'93
|
|
469 "abs" "access" "after" "alias" "all" "and" "assert"
|
|
470 "architecture" "array" "attribute"
|
|
471 "begin" "block" "body" "buffer" "bus"
|
|
472 "case" "component" "configuration" "constant"
|
|
473 "disconnect" "downto"
|
|
474 "else" "elsif" "end" "entity" "exit"
|
|
475 "file" "for" "function"
|
|
476 "generate" "generic" "group" "guarded"
|
|
477 "if" "impure" "in" "inertial" "inout" "is"
|
|
478 "label" "library" "linkage" "literal" "loop"
|
|
479 "map" "mod"
|
|
480 "nand" "new" "next" "nor" "not" "null"
|
|
481 "of" "on" "open" "or" "others" "out"
|
|
482 "package" "port" "postponed" "procedure" "process" "pure"
|
|
483 "range" "record" "register" "reject" "rem" "report" "return"
|
|
484 "rol" "ror"
|
|
485 "select" "severity" "signal" "shared" "sla" "sll" "sra" "srl"
|
|
486 "subtype"
|
|
487 "then" "to" "transport" "type"
|
|
488 "unaffected" "units" "until" "use"
|
|
489 "variable" "wait" "when" "while" "with"
|
|
490 "xnor" "xor"
|
|
491 "note" "warning" "error" "failure"
|
|
492 ;; the following list contains predefined attributes
|
|
493 "base" "left" "right" "high" "low" "pos" "val" "succ"
|
|
494 "pred" "leftof" "rightof" "range" "reverse_range"
|
|
495 "length" "delayed" "stable" "quiet" "transaction"
|
|
496 "event" "active" "last_event" "last_active" "last_value"
|
|
497 "driving" "driving_value" "ascending" "value" "image"
|
|
498 "simple_name" "instance_name" "path_name"
|
|
499 "foreign"
|
|
500 ;; the following list contains standardized types
|
|
501 "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
|
|
502 "real" "time" "natural" "positive" "string" "text" "line"
|
|
503 "unsigned" "signed"
|
|
504 "std_logic" "std_logic_vector"
|
|
505 "std_ulogic" "std_ulogic_vector"
|
|
506 )
|
|
507 "\\|")
|
|
508 "\\)\\>[^\\s_]")
|
|
509 1 'font-lock-keyword-face)
|
|
510 )))
|
|
511 "For consideration as a value of `vhdl-font-lock-keywords'.
|
|
512 This does a lot more highlighting.")
|
|
513
|
|
514 ;; The keywords in the preceding lists assume case-insensitivity.
|
|
515 (put 'vhdl-mode 'font-lock-keywords-case-fold-search t)
|
|
516
|
|
517 (defvar vhdl-font-lock-keywords vhdl-font-lock-keywords-1
|
|
518 "Additional expressions to highlight in VHDL mode.")
|
|
519
|
|
520 ;; This should eventually be subsumed into the respective functions in
|
|
521 ;; the source for "font-lock.el".
|
|
522 (if (featurep 'advice)
|
|
523 (progn
|
|
524 (defadvice font-lock-use-default-minimal-decoration
|
|
525 (before vhdl-mode activate)
|
|
526 "Do it for VHDL mode too."
|
|
527 (setq vhdl-font-lock-keywords vhdl-font-lock-keywords-1))
|
|
528
|
|
529 (defadvice font-lock-use-default-maximal-decoration
|
|
530 (before vhdl-mode activate)
|
|
531 "Do it for VHDL mode too."
|
|
532 (setq vhdl-font-lock-keywords vhdl-font-lock-keywords-2))
|
|
533 ))
|
|
534
|
|
535
|
|
536 ;; Main entry point for VHDL mode:
|
|
537
|
|
538 ;;;###autoload
|
|
539 (defun vhdl-mode ()
|
|
540 "Major mode for editing VHDL code.
|
161
|
541 vhdl-mode $Revision: 1.5 $
|
72
|
542 To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a
|
|
543 vhdl-mode buffer. This automatically sets up a mail buffer with version
|
|
544 information already added. You just need to add a description of the
|
108
|
545 problem, including a reproducible test case and send the message.
|
72
|
546
|
|
547 Note that the details of configuring vhdl-mode will soon be moved to the
|
|
548 accompanying texinfo manual. Until then, please read the README file
|
|
549 that came with the vhdl-mode distribution.
|
|
550
|
|
551 The hook variable `vhdl-mode-hook' is run with no args, if that value is
|
|
552 bound and has a non-nil value.
|
|
553
|
|
554 Key bindings:
|
|
555 \\{vhdl-mode-map}"
|
|
556 (interactive)
|
|
557 (kill-all-local-variables)
|
|
558 (set-syntax-table vhdl-mode-syntax-table)
|
|
559 (setq major-mode 'vhdl-mode
|
|
560 mode-name "VHDL"
|
|
561 local-abbrev-table vhdl-mode-abbrev-table)
|
|
562 (use-local-map vhdl-mode-map)
|
|
563 ;; set local variable values
|
|
564 (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
|
|
565 (set (make-local-variable 'paragraph-separate) paragraph-start)
|
|
566 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
|
|
567 (set (make-local-variable 'require-final-newline) t)
|
|
568 (set (make-local-variable 'parse-sexp-ignore-comments) t)
|
|
569 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
|
|
570 (set (make-local-variable 'comment-start) "-- ")
|
|
571 (set (make-local-variable 'comment-end) "")
|
|
572 (set (make-local-variable 'comment-column) 32)
|
|
573 (set (make-local-variable 'comment-start-skip) "--+ *")
|
|
574 (set (make-local-variable 'outline-regexp) vhdl-outline-regexp)
|
|
575 (set (make-local-variable 'outline-level) 'vhdl-outline-level)
|
|
576
|
|
577 ;; setup the comment indent variable in a Emacs version portable way
|
|
578 ;; ignore any byte compiler warnings you might get here
|
|
579 (if (boundp 'comment-indent-function)
|
|
580 (progn
|
|
581 (make-local-variable 'comment-indent-function)
|
|
582 (setq comment-indent-function 'vhdl-comment-indent))
|
|
583 (make-local-variable 'comment-indent-hook)
|
|
584 (setq comment-indent-hook 'vhdl-comment-indent))
|
|
585 ;; put VHDL menu into menubar and on popup menu for XEmacs (formerly
|
|
586 ;; Lucid) 19. I think this happens automatically for FSF Emacs 19.
|
|
587 (if (and (boundp 'current-menubar)
|
|
588 current-menubar
|
|
589 (not (assoc mode-name current-menubar)))
|
|
590 (progn
|
|
591 (set-buffer-menubar (copy-sequence current-menubar))
|
|
592 (add-menu nil mode-name vhdl-mode-menu)))
|
|
593 (if (boundp 'mode-popup-menu)
|
|
594 (setq mode-popup-menu
|
|
595 (cons (concat mode-name " Mode Commands") vhdl-mode-menu)))
|
|
596 (run-hooks 'vhdl-mode-hook))
|
|
597
|
|
598 ;; menus for XEmacs (formerly Lucid)
|
|
599
|
|
600 (defun vhdl-popup-menu (e)
|
|
601 "Pops up the VHDL menu."
|
|
602 (interactive "@e")
|
|
603 (popup-menu (cons (concat mode-name " Mode Commands") vhdl-mode-menu))
|
|
604 (vhdl-keep-region-active))
|
|
605
|
|
606 ;; active regions
|
|
607
|
|
608 (defun vhdl-keep-region-active ()
|
|
609 ;; do whatever is necessary to keep the region active in XEmacs
|
|
610 ;; (formerly Lucid). ignore byte-compiler warnings you might see
|
|
611 (and (boundp 'zmacs-region-stays)
|
|
612 (setq zmacs-region-stays t)))
|
|
613
|
|
614 ;; constant regular expressions for looking at various constructs
|
|
615
|
|
616 (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
|
|
617 "Regexp describing a VHDL symbol.
|
|
618 We cannot use just `word' syntax class since `_' cannot be in word
|
|
619 class. Putting underscore in word class breaks forward word movement
|
|
620 behavior that users are familiar with.")
|
|
621
|
|
622 (defconst vhdl-case-alternative-key "when[( \t\n][^;=>]+=>"
|
|
623 "Regexp describing a case statement alternative key.")
|
|
624
|
|
625 (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
|
|
626 "Regexp describing a case statement header key.")
|
|
627
|
|
628 (defconst vhdl-label-key
|
|
629 (concat vhdl-symbol-key "\\s-*:")
|
|
630 "Regexp describing a VHDL label.")
|
|
631
|
|
632
|
|
633 ;; Macro definitions:
|
|
634
|
|
635 (defmacro vhdl-point (position)
|
|
636 ;; Returns the value of point at certain commonly referenced POSITIONs.
|
|
637 ;; POSITION can be one of the following symbols:
|
|
638 ;;
|
|
639 ;; bol -- beginning of line
|
|
640 ;; eol -- end of line
|
|
641 ;; bod -- beginning of defun
|
|
642 ;; boi -- back to indentation
|
|
643 ;; eoi -- last whitespace on line
|
|
644 ;; ionl -- indentation of next line
|
|
645 ;; iopl -- indentation of previous line
|
|
646 ;; bonl -- beginning of next line
|
|
647 ;; bopl -- beginning of previous line
|
|
648 ;;
|
|
649 ;; This function does not modify point or mark.
|
|
650 (or (and (eq 'quote (car-safe position))
|
|
651 (null (cdr (cdr position))))
|
|
652 (error "bad buffer position requested: %s" position))
|
|
653 (setq position (nth 1 position))
|
|
654 (` (let ((here (point)))
|
|
655 (,@ (cond
|
|
656 ((eq position 'bol) '((beginning-of-line)))
|
|
657 ((eq position 'eol) '((end-of-line)))
|
|
658 ((eq position 'bod) '((save-match-data
|
|
659 (vhdl-beginning-of-defun))))
|
|
660 ((eq position 'boi) '((back-to-indentation)))
|
|
661 ((eq position 'eoi) '((end-of-line)(skip-chars-backward " \t")))
|
|
662 ((eq position 'bonl) '((forward-line 1)))
|
|
663 ((eq position 'bopl) '((forward-line -1)))
|
|
664 ((eq position 'iopl)
|
|
665 '((forward-line -1)
|
|
666 (back-to-indentation)))
|
|
667 ((eq position 'ionl)
|
|
668 '((forward-line 1)
|
|
669 (back-to-indentation)))
|
|
670 (t (error "unknown buffer position requested: %s" position))
|
|
671 ))
|
|
672 (prog1
|
|
673 (point)
|
|
674 (goto-char here))
|
|
675 ;; workaround for an Emacs18 bug -- blech! Well, at least it
|
|
676 ;; doesn't hurt for v19
|
|
677 (,@ nil)
|
|
678 )))
|
|
679
|
|
680 (defmacro vhdl-safe (&rest body)
|
|
681 ;; safely execute BODY, return nil if an error occurred
|
|
682 (` (condition-case nil
|
|
683 (progn (,@ body))
|
|
684 (error nil))))
|
|
685
|
|
686 (defmacro vhdl-add-syntax (symbol &optional relpos)
|
|
687 ;; a simple macro to append the syntax in symbol to the syntax list.
|
|
688 ;; try to increase performance by using this macro
|
|
689 (` (setq vhdl-syntactic-context
|
|
690 (cons (cons (, symbol) (, relpos)) vhdl-syntactic-context))))
|
|
691
|
|
692 (defmacro vhdl-has-syntax (symbol)
|
|
693 ;; a simple macro to return check the syntax list.
|
|
694 ;; try to increase performance by using this macro
|
|
695 (` (assoc (, symbol) vhdl-syntactic-context)))
|
|
696
|
|
697
|
|
698 ;; Syntactic element offset manipulation:
|
|
699
|
|
700 (defun vhdl-read-offset (langelem)
|
|
701 ;; read new offset value for LANGELEM from minibuffer. return a
|
|
702 ;; legal value only
|
|
703 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
|
|
704 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
|
|
705 (prompt "Offset: ")
|
|
706 offset input interned)
|
|
707 (while (not offset)
|
|
708 (setq input (read-string prompt oldoff)
|
|
709 offset (cond ((string-equal "+" input) '+)
|
|
710 ((string-equal "-" input) '-)
|
|
711 ((string-equal "++" input) '++)
|
|
712 ((string-equal "--" input) '--)
|
|
713 ((string-match "^-?[0-9]+$" input)
|
|
714 (string-to-int input))
|
|
715 ((fboundp (setq interned (intern input)))
|
|
716 interned)
|
|
717 ((boundp interned) interned)
|
|
718 ;; error, but don't signal one, keep trying
|
|
719 ;; to read an input value
|
|
720 (t (ding)
|
|
721 (setq prompt errmsg)
|
|
722 nil))))
|
|
723 offset))
|
|
724
|
|
725 (defun vhdl-set-offset (symbol offset &optional add-p)
|
|
726 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
|
|
727 SYMBOL is the syntactic element symbol to change and OFFSET is the new
|
|
728 offset for that syntactic element. Optional ADD says to add SYMBOL to
|
|
729 `vhdl-offsets-alist' if it doesn't already appear there."
|
|
730 (interactive
|
|
731 (let* ((langelem
|
|
732 (intern (completing-read
|
|
733 (concat "Syntactic symbol to change"
|
|
734 (if current-prefix-arg " or add" "")
|
|
735 ": ")
|
|
736 (mapcar
|
|
737 (function
|
|
738 (lambda (langelem)
|
|
739 (cons (format "%s" (car langelem)) nil)))
|
|
740 vhdl-offsets-alist)
|
|
741 nil (not current-prefix-arg)
|
|
742 ;; initial contents tries to be the last element
|
|
743 ;; on the syntactic analysis list for the current
|
|
744 ;; line
|
|
745 (let* ((syntax (vhdl-get-syntactic-context))
|
|
746 (len (length syntax))
|
|
747 (ic (format "%s" (car (nth (1- len) syntax)))))
|
|
748 (if (memq 'v19 vhdl-emacs-features)
|
|
749 (cons ic 0)
|
|
750 ic))
|
|
751 )))
|
|
752 (offset (vhdl-read-offset langelem)))
|
|
753 (list langelem offset current-prefix-arg)))
|
|
754 ;; sanity check offset
|
|
755 (or (eq offset '+)
|
|
756 (eq offset '-)
|
|
757 (eq offset '++)
|
|
758 (eq offset '--)
|
|
759 (integerp offset)
|
|
760 (fboundp offset)
|
|
761 (boundp offset)
|
|
762 (error "Offset must be int, func, var, or one of +, -, ++, --: %s"
|
|
763 offset))
|
|
764 (let ((entry (assq symbol vhdl-offsets-alist)))
|
|
765 (if entry
|
|
766 (setcdr entry offset)
|
|
767 (if add-p
|
|
768 (setq vhdl-offsets-alist (cons (cons symbol offset) vhdl-offsets-alist))
|
|
769 (error "%s is not a valid syntactic symbol." symbol))))
|
|
770 (vhdl-keep-region-active))
|
|
771
|
|
772 (defun vhdl-set-style (style &optional local)
|
|
773 "Set vhdl-mode variables to use one of several different indentation styles.
|
|
774 STYLE is a string representing the desired style and optional LOCAL is
|
|
775 a flag which, if non-nil, means to make the style variables being
|
|
776 changed buffer local, instead of the default, which is to set the
|
|
777 global variables. Interactively, the flag comes from the prefix
|
|
778 argument. The styles are chosen from the `vhdl-style-alist' variable."
|
|
779 (interactive (list (completing-read "Use which VHDL indentation style? "
|
|
780 vhdl-style-alist nil t)
|
|
781 current-prefix-arg))
|
|
782 (let ((vars (cdr (assoc style vhdl-style-alist))))
|
|
783 (or vars
|
|
784 (error "Invalid VHDL indentation style `%s'" style))
|
|
785 ;; set all the variables
|
|
786 (mapcar
|
|
787 (function
|
|
788 (lambda (varentry)
|
|
789 (let ((var (car varentry))
|
|
790 (val (cdr varentry)))
|
|
791 (and local
|
|
792 (make-local-variable var))
|
|
793 ;; special case for vhdl-offsets-alist
|
|
794 (if (not (eq var 'vhdl-offsets-alist))
|
|
795 (set var val)
|
|
796 ;; reset vhdl-offsets-alist to the default value first
|
|
797 (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default))
|
|
798 ;; now set the langelems that are different
|
|
799 (mapcar
|
|
800 (function
|
|
801 (lambda (langentry)
|
|
802 (let ((langelem (car langentry))
|
|
803 (offset (cdr langentry)))
|
|
804 (vhdl-set-offset langelem offset)
|
|
805 )))
|
|
806 val))
|
|
807 )))
|
|
808 vars))
|
|
809 (vhdl-keep-region-active))
|
|
810
|
|
811 (defun vhdl-get-offset (langelem)
|
|
812 ;; Get offset from LANGELEM which is a cons cell of the form:
|
|
813 ;; (SYMBOL . RELPOS). The symbol is matched against
|
|
814 ;; vhdl-offsets-alist and the offset found there is either returned,
|
|
815 ;; or added to the indentation at RELPOS. If RELPOS is nil, then
|
|
816 ;; the offset is simply returned.
|
|
817 (let* ((symbol (car langelem))
|
|
818 (relpos (cdr langelem))
|
|
819 (match (assq symbol vhdl-offsets-alist))
|
|
820 (offset (cdr-safe match)))
|
|
821 ;; offset can be a number, a function, a variable, or one of the
|
|
822 ;; symbols + or -
|
|
823 (cond
|
|
824 ((not match)
|
|
825 (if vhdl-strict-syntax-p
|
|
826 (error "don't know how to indent a %s" symbol)
|
|
827 (setq offset 0
|
|
828 relpos 0)))
|
|
829 ((eq offset '+) (setq offset vhdl-basic-offset))
|
|
830 ((eq offset '-) (setq offset (- vhdl-basic-offset)))
|
|
831 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
|
|
832 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
|
|
833 ((and (not (numberp offset))
|
|
834 (fboundp offset))
|
|
835 (setq offset (funcall offset langelem)))
|
|
836 ((not (numberp offset))
|
|
837 (setq offset (eval offset)))
|
|
838 )
|
|
839 (+ (if (and relpos
|
|
840 (< relpos (vhdl-point 'bol)))
|
|
841 (save-excursion
|
|
842 (goto-char relpos)
|
|
843 (current-column))
|
|
844 0)
|
|
845 offset)))
|
|
846
|
|
847
|
|
848 ;; Syntactic support functions:
|
|
849
|
|
850 ;; Returns `comment' if in a comment, `string' if in a string literal,
|
|
851 ;; or nil if not in a literal at all. Optional LIM is used as the
|
|
852 ;; backward limit of the search. If omitted, or nil, (point-min) is
|
|
853 ;; used.
|
|
854
|
|
855 (defun vhdl-in-literal (&optional lim)
|
|
856 ;; Determine if point is in a VHDL literal.
|
|
857 (save-excursion
|
|
858 (let* ((lim (or lim (point-min)))
|
|
859 (state (parse-partial-sexp lim (point))))
|
|
860 (cond
|
|
861 ((nth 3 state) 'string)
|
|
862 ((nth 4 state) 'comment)
|
|
863 (t nil)))
|
|
864 ))
|
|
865
|
|
866 ;; This is the best we can do in Win-Emacs.
|
|
867 (defun vhdl-win-il (&optional lim)
|
|
868 ;; Determine if point is in a VHDL literal
|
|
869 (save-excursion
|
|
870 (let* ((here (point))
|
|
871 (state nil)
|
|
872 (match nil)
|
|
873 (lim (or lim (vhdl-point 'bod))))
|
|
874 (goto-char lim )
|
|
875 (while (< (point) here)
|
|
876 (setq match
|
|
877 (and (re-search-forward "--\\|[\"']"
|
|
878 here 'move)
|
|
879 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
880 (setq state
|
|
881 (cond
|
|
882 ;; no match
|
|
883 ((null match) nil)
|
|
884 ;; looking at the opening of a VHDL style comment
|
|
885 ((string= "--" match)
|
|
886 (if (<= here (progn (end-of-line) (point))) 'comment))
|
|
887 ;; looking at the opening of a double quote string
|
|
888 ((string= "\"" match)
|
|
889 (if (not (save-restriction
|
|
890 ;; this seems to be necessary since the
|
|
891 ;; re-search-forward will not work without it
|
|
892 (narrow-to-region (point) here)
|
|
893 (re-search-forward
|
|
894 ;; this regexp matches a double quote
|
|
895 ;; which is preceded by an even number
|
|
896 ;; of backslashes, including zero
|
|
897 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
|
|
898 'string))
|
|
899 ;; looking at the opening of a single quote string
|
|
900 ((string= "'" match)
|
|
901 (if (not (save-restriction
|
|
902 ;; see comments from above
|
|
903 (narrow-to-region (point) here)
|
|
904 (re-search-forward
|
|
905 ;; this matches a single quote which is
|
|
906 ;; preceded by zero or two backslashes.
|
|
907 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
|
|
908 here 'move)))
|
|
909 'string))
|
|
910 (t nil)))
|
|
911 ) ; end-while
|
|
912 state)))
|
|
913
|
|
914 (and (memq 'Win-Emacs vhdl-emacs-features)
|
|
915 (fset 'vhdl-in-literal 'vhdl-win-il))
|
|
916
|
|
917 ;; Skipping of "syntactic whitespace". Syntactic whitespace is
|
|
918 ;; defined as lexical whitespace or comments. Search no farther back
|
|
919 ;; or forward than optional LIM. If LIM is omitted, (point-min) is
|
|
920 ;; used for backward skipping, (point-max) is used for forward
|
|
921 ;; skipping.
|
|
922
|
|
923 (defun vhdl-forward-syntactic-ws (&optional lim)
|
|
924 ;; Forward skip of syntactic whitespace.
|
|
925 (save-restriction
|
|
926 (let* ((lim (or lim (point-max)))
|
|
927 (here lim)
|
|
928 (hugenum (point-max)))
|
|
929 (narrow-to-region lim (point))
|
|
930 (while (/= here (point))
|
|
931 (setq here (point))
|
|
932 (forward-comment hugenum))
|
|
933 )))
|
|
934
|
|
935 ;; This is the best we can do in Win-Emacs.
|
|
936 (defun vhdl-win-fsws (&optional lim)
|
|
937 ;; Forward skip syntactic whitespace for Win-Emacs.
|
|
938 (let ((lim (or lim (point-max)))
|
|
939 stop)
|
|
940 (while (not stop)
|
|
941 (skip-chars-forward " \t\n\r\f" lim)
|
|
942 (cond
|
|
943 ;; vhdl comment
|
|
944 ((looking-at "--") (end-of-line))
|
|
945 ;; none of the above
|
|
946 (t (setq stop t))
|
|
947 ))))
|
|
948
|
|
949 (and (memq 'Win-Emacs vhdl-emacs-features)
|
|
950 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
|
|
951
|
|
952 (defun vhdl-backward-syntactic-ws (&optional lim)
|
|
953 ;; Backward skip over syntactic whitespace.
|
|
954 (save-restriction
|
|
955 (let* ((lim (or lim (point-min)))
|
|
956 (here lim)
|
|
957 (hugenum (- (point-max))))
|
|
958 (if (< lim (point))
|
|
959 (progn
|
|
960 (narrow-to-region lim (point))
|
|
961 (while (/= here (point))
|
|
962 (setq here (point))
|
|
963 (forward-comment hugenum)
|
|
964 )))
|
|
965 )))
|
|
966
|
|
967 ;; This is the best we can do in Win-Emacs.
|
|
968 (defun vhdl-win-bsws (&optional lim)
|
|
969 ;; Backward skip syntactic whitespace for Win-Emacs.
|
|
970 (let ((lim (or lim (vhdl-point 'bod)))
|
|
971 stop)
|
|
972 (while (not stop)
|
|
973 (skip-chars-backward " \t\n\r\f" lim)
|
|
974 (cond
|
|
975 ;; vhdl comment
|
|
976 ((eq (vhdl-in-literal lim) 'comment)
|
|
977 (skip-chars-backward "^-" lim)
|
|
978 (skip-chars-backward "-" lim)
|
|
979 (while (not (or (and (= (following-char) ?-)
|
|
980 (= (char-after (1+ (point))) ?-))
|
|
981 (<= (point) lim)))
|
|
982 (skip-chars-backward "^-" lim)
|
|
983 (skip-chars-backward "-" lim)))
|
|
984 ;; none of the above
|
|
985 (t (setq stop t))
|
|
986 ))))
|
|
987
|
|
988 (and (memq 'Win-Emacs vhdl-emacs-features)
|
|
989 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
|
|
990
|
|
991 ;; Functions to help finding the correct indentation column:
|
|
992
|
|
993 (defun vhdl-first-word (point)
|
|
994 "If the keyword at POINT is at boi, then return (current-column) at
|
|
995 that point, else nil."
|
|
996 (save-excursion
|
|
997 (and (goto-char point)
|
|
998 (eq (point) (vhdl-point 'boi))
|
|
999 (current-column))))
|
|
1000
|
|
1001 (defun vhdl-last-word (point)
|
|
1002 "If the keyword at POINT is at eoi, then return (current-column) at
|
|
1003 that point, else nil."
|
|
1004 (save-excursion
|
|
1005 (and (goto-char point)
|
|
1006 (save-excursion (or (eq (progn (forward-sexp) (point))
|
|
1007 (vhdl-point 'eoi))
|
|
1008 (looking-at "\\s-*\\(--\\)?")))
|
|
1009 (current-column))))
|
|
1010
|
|
1011
|
|
1012 ;; Core syntactic evaluation functions:
|
|
1013
|
|
1014 (defconst vhdl-libunit-re
|
|
1015 "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
|
|
1016
|
|
1017 (defun vhdl-libunit-p ()
|
|
1018 (and
|
|
1019 (save-excursion
|
|
1020 (forward-sexp)
|
|
1021 (skip-chars-forward " \t\n")
|
|
1022 (not (looking-at "is\\b[^_]")))
|
|
1023 (save-excursion
|
|
1024 (backward-sexp)
|
|
1025 (not (looking-at "use\\b[^_]")))))
|
|
1026
|
|
1027 (defconst vhdl-defun-re
|
|
1028 "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedure\\|function\\)\\b[^_]")
|
|
1029
|
|
1030 (defun vhdl-defun-p ()
|
|
1031 (save-excursion
|
|
1032 (if (looking-at "block\\|process")
|
|
1033 ;; "block", "process":
|
|
1034 (save-excursion
|
|
1035 (backward-sexp)
|
|
1036 (not (looking-at "end\\s-+\\w")))
|
|
1037 ;; "architecture", "configuration", "entity",
|
|
1038 ;; "package", "procedure", "function":
|
|
1039 t)))
|
|
1040
|
|
1041 (defun vhdl-corresponding-defun ()
|
|
1042 "If the word at the current position corresponds to a \"defun\"
|
|
1043 keyword, then return a string that can be used to find the
|
|
1044 corresponding \"begin\" keyword, else return nil."
|
|
1045 (save-excursion
|
|
1046 (and (looking-at vhdl-defun-re)
|
|
1047 (vhdl-defun-p)
|
|
1048 (if (looking-at "block\\|process")
|
|
1049 ;; "block", "process":
|
|
1050 (buffer-substring (match-beginning 0) (match-end 0))
|
|
1051 ;; "architecture", "configuration", "entity", "package",
|
|
1052 ;; "procedure", "function":
|
|
1053 "is"))))
|
|
1054
|
|
1055 (defconst vhdl-begin-fwd-re
|
|
1056 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
|
|
1057 "A regular expression for searching forward that matches all known
|
|
1058 \"begin\" keywords.")
|
|
1059
|
|
1060 (defconst vhdl-begin-bwd-re
|
|
1061 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b"
|
|
1062 "A regular expression for searching backward that matches all known
|
|
1063 \"begin\" keywords.")
|
|
1064
|
|
1065 (defun vhdl-begin-p (&optional lim)
|
|
1066 "Return t if we are looking at a real \"begin\" keyword.
|
|
1067 Assumes that the caller will make sure that we are looking at
|
|
1068 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
|
|
1069 the middle of an identifier that just happens to contain a \"begin\"
|
|
1070 keyword."
|
|
1071 (cond
|
|
1072 ;; "[architecture|case|configuration|entity|package|
|
|
1073 ;; procedure|function] ... is":
|
|
1074 ((and (looking-at "i")
|
|
1075 (save-excursion
|
|
1076 ;; Skip backward over first sexp (needed to skip over a
|
|
1077 ;; procedure interface list, and is harmless in other
|
|
1078 ;; situations). Note that we need "return" in the
|
|
1079 ;; following search list so that we don't run into
|
|
1080 ;; semicolons in the function interface list.
|
|
1081 (backward-sexp)
|
|
1082 (let (foundp)
|
|
1083 (while (and (not foundp)
|
|
1084 (re-search-backward
|
|
1085 ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|block\\)\\b[^_]"
|
|
1086 lim 'move))
|
|
1087 (if (or (= (preceding-char) ?_)
|
|
1088 (vhdl-in-literal lim))
|
|
1089 (backward-char)
|
|
1090 (setq foundp t))))
|
|
1091 (and (/= (following-char) ?\;)
|
|
1092 (not (looking-at "is\\|begin\\|process\\|block")))))
|
|
1093 t)
|
|
1094 ;; "begin", "then":
|
|
1095 ((looking-at "be\\|t")
|
|
1096 t)
|
|
1097 ;; "else":
|
|
1098 ((and (looking-at "e")
|
|
1099 ;; make sure that the "else" isn't inside a
|
|
1100 ;; conditional signal assignment.
|
|
1101 (save-excursion
|
|
1102 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
|
|
1103 (or (eq (following-char) ?\;)
|
|
1104 (eq (point) lim))))
|
|
1105 t)
|
|
1106 ;; "block", "component", "generate", "loop", "process",
|
|
1107 ;; "units", "record":
|
|
1108 ((and (looking-at "bl\\|[cglpur]")
|
|
1109 (save-excursion
|
|
1110 (backward-sexp)
|
|
1111 (not (looking-at "end\\s-+\\w"))))
|
|
1112 t)
|
|
1113 ;; "for" (inside configuration declaration):
|
|
1114 ((and (looking-at "f")
|
|
1115 (save-excursion
|
|
1116 (backward-sexp)
|
|
1117 (not (looking-at "end\\s-+\\w")))
|
|
1118 (vhdl-has-syntax 'configuration))
|
|
1119 t)
|
|
1120 ))
|
|
1121
|
|
1122 (defun vhdl-corresponding-mid (&optional lim)
|
|
1123 (cond
|
|
1124 ((looking-at "is\\|block\\|process")
|
|
1125 "begin")
|
|
1126 ((looking-at "then")
|
|
1127 "<else>")
|
|
1128 (t
|
|
1129 "end")))
|
|
1130
|
|
1131 (defun vhdl-corresponding-end (&optional lim)
|
|
1132 "If the word at the current position corresponds to a \"begin\"
|
|
1133 keyword, then return a vector containing enough information to find
|
|
1134 the corresponding \"end\" keyword, else return nil. The keyword to
|
|
1135 search forward for is aref 0. The column in which the keyword must
|
|
1136 appear is aref 1 or nil if any column is suitable.
|
|
1137 Assumes that the caller will make sure that we are not in the middle
|
|
1138 of an identifier that just happens to contain a \"begin\" keyword."
|
|
1139 (save-excursion
|
|
1140 (and (looking-at vhdl-begin-fwd-re)
|
|
1141 (/= (preceding-char) ?_)
|
|
1142 (not (vhdl-in-literal lim))
|
|
1143 (vhdl-begin-p lim)
|
|
1144 (cond
|
|
1145 ;; "is", "generate", "loop":
|
|
1146 ((looking-at "[igl]")
|
|
1147 (vector "end"
|
|
1148 (and (vhdl-last-word (point))
|
|
1149 (or (vhdl-first-word (point))
|
|
1150 (save-excursion
|
|
1151 (vhdl-beginning-of-statement-1 lim)
|
|
1152 (vhdl-backward-skip-label lim)
|
|
1153 (vhdl-first-word (point)))))))
|
|
1154 ;; "begin", "else", "for":
|
|
1155 ((looking-at "be\\|[ef]")
|
|
1156 (vector "end"
|
|
1157 (and (vhdl-last-word (point))
|
|
1158 (or (vhdl-first-word (point))
|
|
1159 (save-excursion
|
|
1160 (vhdl-beginning-of-statement-1 lim)
|
|
1161 (vhdl-backward-skip-label lim)
|
|
1162 (vhdl-first-word (point)))))))
|
|
1163 ;; "component", "units", "record":
|
|
1164 ((looking-at "[cur]")
|
|
1165 ;; The first end found will close the block
|
|
1166 (vector "end" nil))
|
|
1167 ;; "block", "process":
|
|
1168 ((looking-at "bl\\|p")
|
|
1169 (vector "end"
|
|
1170 (or (vhdl-first-word (point))
|
|
1171 (save-excursion
|
|
1172 (vhdl-beginning-of-statement-1 lim)
|
|
1173 (vhdl-backward-skip-label lim)
|
|
1174 (vhdl-first-word (point))))))
|
|
1175 ;; "then":
|
|
1176 ((looking-at "t")
|
|
1177 (vector "elsif\\|else\\|end"
|
|
1178 (and (vhdl-last-word (point))
|
|
1179 (or (vhdl-first-word (point))
|
|
1180 (save-excursion
|
|
1181 (vhdl-beginning-of-statement-1 lim)
|
|
1182 (vhdl-backward-skip-label lim)
|
|
1183 (vhdl-first-word (point)))))))
|
|
1184 ))))
|
|
1185
|
|
1186 (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
|
|
1187
|
|
1188 (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b")
|
|
1189
|
|
1190 (defun vhdl-end-p (&optional lim)
|
|
1191 "Return t if we are looking at a real \"end\" keyword.
|
|
1192 Assumes that the caller will make sure that we are looking at
|
|
1193 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
|
|
1194 the middle of an identifier that just happens to contain an \"end\"
|
|
1195 keyword."
|
|
1196 (or (not (looking-at "else"))
|
|
1197 ;; make sure that the "else" isn't inside a conditional signal
|
|
1198 ;; assignment.
|
|
1199 (save-excursion
|
|
1200 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
|
|
1201 (or (eq (following-char) ?\;)
|
|
1202 (eq (point) lim)))))
|
|
1203
|
|
1204 (defun vhdl-corresponding-begin (&optional lim)
|
|
1205 "If the word at the current position corresponds to an \"end\"
|
|
1206 keyword, then return a vector containing enough information to find
|
|
1207 the corresponding \"begin\" keyword, else return nil. The keyword to
|
|
1208 search backward for is aref 0. The column in which the keyword must
|
|
1209 appear is aref 1 or nil if any column is suitable. The supplementary
|
|
1210 keyword to search forward for is aref 2 or nil if this is not
|
|
1211 required. If aref 3 is t, then the \"begin\" keyword may be found in
|
|
1212 the middle of a statement.
|
|
1213 Assumes that the caller will make sure that we are not in the middle
|
|
1214 of an identifier that just happens to contain an \"end\" keyword."
|
|
1215 (save-excursion
|
|
1216 (let (pos)
|
|
1217 (if (and (looking-at vhdl-end-fwd-re)
|
|
1218 (not (vhdl-in-literal lim))
|
|
1219 (vhdl-end-p lim))
|
|
1220 (if (looking-at "el")
|
|
1221 ;; "else", "elsif":
|
|
1222 (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil)
|
|
1223 ;; "end ...":
|
|
1224 (setq pos (point))
|
|
1225 (forward-sexp)
|
|
1226 (skip-chars-forward " \t\n")
|
|
1227 (cond
|
|
1228 ;; "end if":
|
|
1229 ((looking-at "if\\b[^_]")
|
|
1230 (vector "else\\|elsif\\|if"
|
|
1231 (vhdl-first-word pos)
|
|
1232 "else\\|then" nil))
|
|
1233 ;; "end component":
|
|
1234 ((looking-at "component\\b[^_]")
|
|
1235 (vector (buffer-substring (match-beginning 1)
|
|
1236 (match-end 1))
|
|
1237 (vhdl-first-word pos)
|
|
1238 nil nil))
|
|
1239 ;; "end units", "end record":
|
|
1240 ((looking-at "\\(units\\|record\\)\\b[^_]")
|
|
1241 (vector (buffer-substring (match-beginning 1)
|
|
1242 (match-end 1))
|
|
1243 (vhdl-first-word pos)
|
|
1244 nil t))
|
|
1245 ;; "end block", "end process":
|
|
1246 ((looking-at "\\(block\\|process\\)\\b[^_]")
|
|
1247 (vector "begin" (vhdl-first-word pos) nil nil))
|
|
1248 ;; "end case":
|
|
1249 ((looking-at "case\\b[^_]")
|
|
1250 (vector "case" (vhdl-first-word pos) "is" nil))
|
|
1251 ;; "end generate":
|
|
1252 ((looking-at "generate\\b[^_]")
|
|
1253 (vector "generate\\|for\\|if"
|
|
1254 (vhdl-first-word pos)
|
|
1255 "generate" nil))
|
|
1256 ;; "end loop":
|
|
1257 ((looking-at "loop\\b[^_]")
|
|
1258 (vector "loop\\|while\\|for"
|
|
1259 (vhdl-first-word pos)
|
|
1260 "loop" nil))
|
|
1261 ;; "end for" (inside configuration declaration):
|
|
1262 ((looking-at "for\\b[^_]")
|
|
1263 (vector "for" (vhdl-first-word pos) nil nil))
|
|
1264 ;; "end [id]":
|
|
1265 (t
|
|
1266 (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
|
|
1267 (vhdl-first-word pos)
|
|
1268 ;; return an alist of (statement . keyword) mappings
|
|
1269 '(
|
|
1270 ;; "begin ... end [id]":
|
|
1271 ("begin" . nil)
|
|
1272 ;; "architecture ... is ... begin ... end [id]":
|
|
1273 ("architecture" . "is")
|
|
1274 ;; "configuration ... is ... end [id]":
|
|
1275 ("configuration" . "is")
|
|
1276 ;; "entity ... is ... end [id]":
|
|
1277 ("entity" . "is")
|
|
1278 ;; "package ... is ... end [id]":
|
|
1279 ("package" . "is")
|
|
1280 ;; "procedure ... is ... begin ... end [id]":
|
|
1281 ("procedure" . "is")
|
|
1282 ;; "function ... is ... begin ... end [id]":
|
|
1283 ("function" . "is")
|
|
1284 )
|
|
1285 nil))
|
|
1286 ))) ; "end ..."
|
|
1287 )))
|
|
1288
|
|
1289 (defconst vhdl-leader-re
|
|
1290 "\\b\\(block\\|component\\|process\\|for\\)\\b[^_]")
|
|
1291
|
|
1292 (defun vhdl-end-of-leader ()
|
|
1293 (save-excursion
|
|
1294 (cond ((looking-at "block\\|process")
|
|
1295 (if (save-excursion
|
|
1296 (forward-sexp)
|
|
1297 (skip-chars-forward " \t\n")
|
|
1298 (= (following-char) ?\())
|
|
1299 (forward-sexp 2)
|
|
1300 (forward-sexp))
|
|
1301 (point))
|
|
1302 ((looking-at "component")
|
|
1303 (forward-sexp 2)
|
|
1304 (point))
|
|
1305 ((looking-at "for")
|
|
1306 (forward-sexp 2)
|
|
1307 (skip-chars-forward " \t\n")
|
|
1308 (while (looking-at "[,:(]")
|
|
1309 (forward-sexp)
|
|
1310 (skip-chars-forward " \t\n"))
|
|
1311 (point))
|
|
1312 (t nil)
|
|
1313 )))
|
|
1314
|
|
1315 (defconst vhdl-trailer-re
|
|
1316 "\\b\\(is\\|then\\|generate\\|loop\\)\\b[^_]")
|
|
1317
|
|
1318 (defconst vhdl-statement-fwd-re
|
|
1319 "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
|
|
1320 "A regular expression for searching forward that matches all known
|
|
1321 \"statement\" keywords.")
|
|
1322
|
|
1323 (defconst vhdl-statement-bwd-re
|
|
1324 "\\b\\(if\\|for\\|while\\)\\b"
|
|
1325 "A regular expression for searching backward that matches all known
|
|
1326 \"statement\" keywords.")
|
|
1327
|
|
1328 (defun vhdl-statement-p (&optional lim)
|
|
1329 "Return t if we are looking at a real \"statement\" keyword.
|
|
1330 Assumes that the caller will make sure that we are looking at
|
|
1331 vhdl-statement-fwd-re, and are not inside a literal, and that we are not in
|
|
1332 the middle of an identifier that just happens to contain a \"statement\"
|
|
1333 keyword."
|
|
1334 (cond
|
|
1335 ;; "for" ... "generate":
|
|
1336 ((and (looking-at "f")
|
|
1337 ;; Make sure it's the start of a parameter specification.
|
|
1338 (save-excursion
|
|
1339 (forward-sexp 2)
|
|
1340 (skip-chars-forward " \t\n")
|
|
1341 (looking-at "in\\b[^_]"))
|
|
1342 ;; Make sure it's not an "end for".
|
|
1343 (save-excursion
|
|
1344 (backward-sexp)
|
|
1345 (not (looking-at "end\\s-+\\w"))))
|
|
1346 t)
|
|
1347 ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
|
|
1348 ((and (looking-at "i")
|
|
1349 ;; Make sure it's not an "end if".
|
|
1350 (save-excursion
|
|
1351 (backward-sexp)
|
|
1352 (not (looking-at "end\\s-+\\w"))))
|
|
1353 t)
|
|
1354 ;; "while" ... "loop":
|
|
1355 ((looking-at "w")
|
|
1356 t)
|
|
1357 ))
|
|
1358
|
|
1359
|
|
1360 ;; Core syntactic movement functions:
|
|
1361
|
|
1362 (defconst vhdl-b-t-b-re
|
|
1363 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
|
|
1364
|
|
1365 (defun vhdl-backward-to-block (&optional lim)
|
|
1366 "Move backward to the previous \"begin\" or \"end\" keyword."
|
|
1367 (let (foundp)
|
|
1368 (while (and (not foundp)
|
|
1369 (re-search-backward vhdl-b-t-b-re lim 'move))
|
|
1370 (if (or (= (preceding-char) ?_)
|
|
1371 (vhdl-in-literal lim))
|
|
1372 (backward-char)
|
|
1373 (cond
|
|
1374 ;; "begin" keyword:
|
|
1375 ((and (looking-at vhdl-begin-fwd-re)
|
|
1376 (/= (preceding-char) ?_)
|
|
1377 (vhdl-begin-p lim))
|
|
1378 (setq foundp 'begin))
|
|
1379 ;; "end" keyword:
|
|
1380 ((and (looking-at vhdl-end-fwd-re)
|
|
1381 (/= (preceding-char) ?_)
|
|
1382 (vhdl-end-p lim))
|
|
1383 (setq foundp 'end))
|
|
1384 ))
|
|
1385 )
|
|
1386 foundp
|
|
1387 ))
|
|
1388
|
|
1389 (defun vhdl-forward-sexp (&optional count lim)
|
|
1390 "Move forward across one balanced expression (sexp).
|
|
1391 With COUNT, do it that many times."
|
|
1392 (interactive "p")
|
|
1393 (let ((count (or count 1))
|
|
1394 (case-fold-search t)
|
|
1395 end-vec target)
|
|
1396 (save-excursion
|
|
1397 (while (> count 0)
|
|
1398 ;; skip whitespace
|
|
1399 (skip-chars-forward " \t\n")
|
|
1400 ;; Check for an unbalanced "end" keyword
|
|
1401 (if (and (looking-at vhdl-end-fwd-re)
|
|
1402 (/= (preceding-char) ?_)
|
|
1403 (not (vhdl-in-literal lim))
|
|
1404 (vhdl-end-p lim)
|
|
1405 (not (looking-at "else")))
|
|
1406 (error
|
|
1407 "Containing expression ends prematurely in vhdl-forward-sexp"))
|
|
1408 ;; If the current keyword is a "begin" keyword, then find the
|
|
1409 ;; corresponding "end" keyword.
|
|
1410 (if (setq end-vec (vhdl-corresponding-end lim))
|
|
1411 (let (
|
|
1412 ;; end-re is the statement keyword to search for
|
|
1413 (end-re
|
|
1414 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
|
|
1415 ;; column is either the statement keyword target column
|
|
1416 ;; or nil
|
|
1417 (column (aref end-vec 1))
|
|
1418 (eol (vhdl-point 'eol))
|
|
1419 foundp literal placeholder)
|
|
1420 ;; Look for the statement keyword.
|
|
1421 (while (and (not foundp)
|
|
1422 (re-search-forward end-re nil t)
|
|
1423 (setq placeholder (match-end 1))
|
|
1424 (goto-char (match-beginning 0)))
|
|
1425 ;; If we are in a literal, or not in the right target
|
|
1426 ;; column and not on the same line as the begin, then
|
|
1427 ;; try again.
|
|
1428 (if (or (and column
|
|
1429 (/= (current-indentation) column)
|
|
1430 (> (point) eol))
|
|
1431 (= (preceding-char) ?_)
|
|
1432 (setq literal (vhdl-in-literal lim)))
|
|
1433 (if (eq literal 'comment)
|
|
1434 (end-of-line)
|
|
1435 (forward-char))
|
|
1436 ;; An "else" keyword corresponds to both the opening brace
|
|
1437 ;; of the following sexp and the closing brace of the
|
|
1438 ;; previous sexp.
|
|
1439 (if (not (looking-at "else"))
|
|
1440 (goto-char placeholder))
|
|
1441 (setq foundp t))
|
|
1442 )
|
|
1443 (if (not foundp)
|
|
1444 (error "Unbalanced keywords in vhdl-forward-sexp"))
|
|
1445 )
|
|
1446 ;; If the current keyword is not a "begin" keyword, then just
|
|
1447 ;; perform the normal forward-sexp.
|
|
1448 (forward-sexp)
|
|
1449 )
|
|
1450 (setq count (1- count))
|
|
1451 )
|
|
1452 (setq target (point)))
|
|
1453 (goto-char target)
|
|
1454 nil))
|
|
1455
|
|
1456 (defun vhdl-backward-sexp (&optional count lim)
|
|
1457 "Move backward across one balanced expression (sexp).
|
|
1458 With COUNT, do it that many times. LIM bounds any required backward
|
|
1459 searches."
|
|
1460 (interactive "p")
|
|
1461 (let ((count (or count 1))
|
|
1462 (case-fold-search t)
|
|
1463 begin-vec target)
|
|
1464 (save-excursion
|
|
1465 (while (> count 0)
|
|
1466 ;; Perform the normal backward-sexp, unless we are looking at
|
|
1467 ;; "else" - an "else" keyword corresponds to both the opening brace
|
|
1468 ;; of the following sexp and the closing brace of the previous sexp.
|
|
1469 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
|
|
1470 (/= (preceding-char) ?_)
|
|
1471 (not (vhdl-in-literal lim)))
|
|
1472 nil
|
|
1473 (backward-sexp)
|
|
1474 (if (and (looking-at vhdl-begin-fwd-re)
|
|
1475 (/= (preceding-char) ?_)
|
|
1476 (not (vhdl-in-literal lim))
|
|
1477 (vhdl-begin-p lim))
|
|
1478 (error "Containing expression ends prematurely in vhdl-backward-sexp")))
|
|
1479 ;; If the current keyword is an "end" keyword, then find the
|
|
1480 ;; corresponding "begin" keyword.
|
|
1481 (if (and (setq begin-vec (vhdl-corresponding-begin lim))
|
|
1482 (/= (preceding-char) ?_))
|
|
1483 (let (
|
|
1484 ;; begin-re is the statement keyword to search for
|
|
1485 (begin-re
|
|
1486 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
|
|
1487 ;; column is either the statement keyword target column
|
|
1488 ;; or nil
|
|
1489 (column (aref begin-vec 1))
|
|
1490 ;; internal-p controls where the statement keyword can
|
|
1491 ;; be found.
|
|
1492 (internal-p (aref begin-vec 3))
|
|
1493 (last-backward (point)) last-forward
|
|
1494 foundp literal keyword)
|
|
1495 ;; Look for the statement keyword.
|
|
1496 (while (and (not foundp)
|
|
1497 (re-search-backward begin-re lim t)
|
|
1498 (setq keyword
|
|
1499 (buffer-substring (match-beginning 1)
|
|
1500 (match-end 1))))
|
|
1501 ;; If we are in a literal or in the wrong column,
|
|
1502 ;; then try again.
|
|
1503 (if (or (and column
|
|
1504 (and (/= (current-indentation) column)
|
|
1505 ;; possibly accept current-column as
|
|
1506 ;; well as current-indentation.
|
|
1507 (or (not internal-p)
|
|
1508 (/= (current-column) column))))
|
|
1509 (= (preceding-char) ?_)
|
|
1510 (vhdl-in-literal lim))
|
|
1511 (backward-char)
|
|
1512 ;; If there is a supplementary keyword, then
|
|
1513 ;; search forward for it.
|
|
1514 (if (and (setq begin-re (aref begin-vec 2))
|
|
1515 (or (not (listp begin-re))
|
|
1516 ;; If begin-re is an alist, then find the
|
|
1517 ;; element corresponding to the actual
|
|
1518 ;; keyword that we found.
|
|
1519 (progn
|
|
1520 (setq begin-re
|
|
1521 (assoc keyword begin-re))
|
|
1522 (and begin-re
|
|
1523 (setq begin-re (cdr begin-re))))))
|
|
1524 (and
|
|
1525 (setq begin-re
|
|
1526 (concat "\\b\\(" begin-re "\\)\\b[^_]"))
|
|
1527 (save-excursion
|
|
1528 (setq last-forward (point))
|
|
1529 ;; Look for the supplementary keyword
|
|
1530 ;; (bounded by the backward search start
|
|
1531 ;; point).
|
|
1532 (while (and (not foundp)
|
|
1533 (re-search-forward begin-re
|
|
1534 last-backward t)
|
|
1535 (goto-char (match-beginning 1)))
|
|
1536 ;; If we are in a literal, then try again.
|
|
1537 (if (or (= (preceding-char) ?_)
|
|
1538 (setq literal
|
|
1539 (vhdl-in-literal last-forward)))
|
|
1540 (if (eq literal 'comment)
|
|
1541 (goto-char
|
|
1542 (min (vhdl-point 'eol) last-backward))
|
|
1543 (forward-char))
|
|
1544 ;; We have found the supplementary keyword.
|
|
1545 ;; Save the position of the keyword in foundp.
|
|
1546 (setq foundp (point)))
|
|
1547 )
|
|
1548 foundp)
|
|
1549 ;; If the supplementary keyword was found, then
|
|
1550 ;; move point to the supplementary keyword.
|
|
1551 (goto-char foundp))
|
|
1552 ;; If there was no supplementary keyword, then
|
|
1553 ;; point is already at the statement keyword.
|
|
1554 (setq foundp t)))
|
|
1555 ) ; end of the search for the statement keyword
|
|
1556 (if (not foundp)
|
|
1557 (error "Unbalanced keywords in vhdl-backward-sexp"))
|
|
1558 ))
|
|
1559 (setq count (1- count))
|
|
1560 )
|
|
1561 (setq target (point)))
|
|
1562 (goto-char target)
|
|
1563 nil))
|
|
1564
|
|
1565 (defun vhdl-backward-up-list (&optional count limit)
|
|
1566 "Move backward out of one level of blocks.
|
|
1567 With argument, do this that many times."
|
|
1568 (interactive "p")
|
|
1569 (let ((count (or count 1))
|
|
1570 target)
|
|
1571 (save-excursion
|
|
1572 (while (> count 0)
|
|
1573 (if (looking-at vhdl-defun-re)
|
|
1574 (error "Unbalanced blocks"))
|
|
1575 (vhdl-backward-to-block limit)
|
|
1576 (setq count (1- count)))
|
|
1577 (setq target (point)))
|
|
1578 (goto-char target)))
|
|
1579
|
|
1580 (defun vhdl-end-of-defun (&optional count)
|
|
1581 "Move forward to the end of a VHDL defun."
|
|
1582 (interactive)
|
|
1583 (let ((case-fold-search t))
|
|
1584 (vhdl-beginning-of-defun)
|
|
1585 (if (not (looking-at "block\\|process"))
|
|
1586 (re-search-forward "\\bis\\b"))
|
|
1587 (vhdl-forward-sexp)))
|
|
1588
|
|
1589 (defun vhdl-mark-defun ()
|
|
1590 "Put mark at end of this \"defun\", point at beginning."
|
|
1591 (interactive)
|
|
1592 (let ((case-fold-search t))
|
|
1593 (push-mark)
|
|
1594 (vhdl-beginning-of-defun)
|
|
1595 (push-mark)
|
|
1596 (if (not (looking-at "block\\|process"))
|
|
1597 (re-search-forward "\\bis\\b"))
|
|
1598 (vhdl-forward-sexp)
|
|
1599 (exchange-point-and-mark)))
|
|
1600
|
|
1601 (defun vhdl-beginning-of-libunit ()
|
|
1602 "Move backward to the beginning of a VHDL library unit.
|
|
1603 Returns the location of the corresponding begin keyword, unless search
|
|
1604 stops due to beginning or end of buffer."
|
|
1605 ;; Note that if point is between the "libunit" keyword and the
|
|
1606 ;; corresponding "begin" keyword, then that libunit will not be
|
|
1607 ;; recognised, and the search will continue backwards. If point is
|
|
1608 ;; at the "begin" keyword, then the defun will be recognised. The
|
|
1609 ;; returned point is at the first character of the "libunit" keyword.
|
|
1610 (let ((last-forward (point))
|
|
1611 (last-backward
|
|
1612 ;; Just in case we are actually sitting on the "begin"
|
|
1613 ;; keyword, allow for the keyword and an extra character,
|
|
1614 ;; as this will be used when looking forward for the
|
|
1615 ;; "begin" keyword.
|
|
1616 (save-excursion (forward-word 1) (1+ (point))))
|
|
1617 foundp literal placeholder)
|
|
1618 ;; Find the "libunit" keyword.
|
|
1619 (while (and (not foundp)
|
|
1620 (re-search-backward vhdl-libunit-re nil 'move))
|
|
1621 ;; If we are in a literal, or not at a real libunit, then try again.
|
|
1622 (if (or (= (preceding-char) ?_)
|
|
1623 (vhdl-in-literal (point-min))
|
|
1624 (not (vhdl-libunit-p)))
|
|
1625 (backward-char)
|
|
1626 ;; Find the corresponding "begin" keyword.
|
|
1627 (setq last-forward (point))
|
|
1628 (while (and (not foundp)
|
|
1629 (re-search-forward "\\bis\\b[^_]" last-backward t)
|
|
1630 (setq placeholder (match-beginning 0)))
|
|
1631 (if (or (= (preceding-char) ?_)
|
|
1632 (setq literal (vhdl-in-literal last-forward)))
|
|
1633 ;; It wasn't a real keyword, so keep searching.
|
|
1634 (if (eq literal 'comment)
|
|
1635 (goto-char
|
|
1636 (min (vhdl-point 'eol) last-backward))
|
|
1637 (forward-char))
|
|
1638 ;; We have found the begin keyword, loop will exit.
|
|
1639 (setq foundp placeholder)))
|
|
1640 ;; Go back to the libunit keyword
|
|
1641 (goto-char last-forward)))
|
|
1642 foundp))
|
|
1643
|
|
1644 (defun vhdl-beginning-of-defun (&optional count)
|
|
1645 "Move backward to the beginning of a VHDL defun.
|
|
1646 With argument, do it that many times.
|
|
1647 Returns the location of the corresponding begin keyword, unless search
|
|
1648 stops due to beginning or end of buffer."
|
|
1649 ;; Note that if point is between the "defun" keyword and the
|
|
1650 ;; corresponding "begin" keyword, then that defun will not be
|
|
1651 ;; recognised, and the search will continue backwards. If point is
|
|
1652 ;; at the "begin" keyword, then the defun will be recognised. The
|
|
1653 ;; returned point is at the first character of the "defun" keyword.
|
|
1654 (interactive "p")
|
|
1655 (let ((count (or count 1))
|
|
1656 (case-fold-search t)
|
|
1657 (last-forward (point))
|
|
1658 foundp)
|
|
1659 (while (> count 0)
|
|
1660 (setq foundp nil)
|
|
1661 (goto-char last-forward)
|
|
1662 (let ((last-backward
|
|
1663 ;; Just in case we are actually sitting on the "begin"
|
|
1664 ;; keyword, allow for the keyword and an extra character,
|
|
1665 ;; as this will be used when looking forward for the
|
|
1666 ;; "begin" keyword.
|
|
1667 (save-excursion (forward-word 1) (1+ (point))))
|
|
1668 begin-string literal)
|
|
1669 (while (and (not foundp)
|
|
1670 (re-search-backward vhdl-defun-re nil 'move))
|
|
1671 ;; If we are in a literal, then try again.
|
|
1672 (if (or (= (preceding-char) ?_)
|
|
1673 (vhdl-in-literal (point-min)))
|
|
1674 (backward-char)
|
|
1675 (if (setq begin-string (vhdl-corresponding-defun))
|
|
1676 ;; This is a real defun keyword.
|
|
1677 ;; Find the corresponding "begin" keyword.
|
|
1678 ;; Look for the begin keyword.
|
|
1679 (progn
|
|
1680 ;; Save the search start point.
|
|
1681 (setq last-forward (point))
|
|
1682 (while (and (not foundp)
|
|
1683 (search-forward begin-string last-backward t))
|
|
1684 (if (or (= (preceding-char) ?_)
|
|
1685 (save-match-data
|
|
1686 (setq literal (vhdl-in-literal last-forward))))
|
|
1687 ;; It wasn't a real keyword, so keep searching.
|
|
1688 (if (eq literal 'comment)
|
|
1689 (goto-char
|
|
1690 (min (vhdl-point 'eol) last-backward))
|
|
1691 (forward-char))
|
|
1692 ;; We have found the begin keyword, loop will exit.
|
|
1693 (setq foundp (match-beginning 0)))
|
|
1694 )
|
|
1695 ;; Go back to the defun keyword
|
|
1696 (goto-char last-forward)) ; end search for begin keyword
|
|
1697 ))
|
|
1698 ) ; end of the search for the defun keyword
|
|
1699 )
|
|
1700 (setq count (1- count))
|
|
1701 )
|
|
1702 (vhdl-keep-region-active)
|
|
1703 foundp))
|
|
1704
|
|
1705 (defun vhdl-beginning-of-statement (&optional count lim)
|
|
1706 "Go to the beginning of the innermost VHDL statement.
|
|
1707 With prefix arg, go back N - 1 statements. If already at the
|
|
1708 beginning of a statement then go to the beginning of the preceding
|
|
1709 one. If within a string or comment, or next to a comment (only
|
|
1710 whitespace between), move by sentences instead of statements.
|
|
1711
|
|
1712 When called from a program, this function takes 2 optional args: the
|
|
1713 prefix arg, and a buffer position limit which is the farthest back to
|
|
1714 search."
|
|
1715 (interactive "p")
|
|
1716 (let ((count (or count 1))
|
|
1717 (case-fold-search t)
|
|
1718 (lim (or lim (point-min)))
|
|
1719 (here (point))
|
|
1720 state)
|
|
1721 (save-excursion
|
|
1722 (goto-char lim)
|
|
1723 (setq state (parse-partial-sexp (point) here nil nil)))
|
|
1724 (if (and (interactive-p)
|
|
1725 (or (nth 3 state)
|
|
1726 (nth 4 state)
|
|
1727 (looking-at (concat "[ \t]*" comment-start-skip))))
|
|
1728 (forward-sentence (- count))
|
|
1729 (while (> count 0)
|
|
1730 (vhdl-beginning-of-statement-1 lim)
|
|
1731 (setq count (1- count))))
|
|
1732 ;; its possible we've been left up-buf of lim
|
|
1733 (goto-char (max (point) lim))
|
|
1734 )
|
|
1735 (vhdl-keep-region-active))
|
|
1736
|
|
1737 (defconst vhdl-b-o-s-re
|
|
1738 (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
|
|
1739 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
|
|
1740
|
|
1741 (defun vhdl-beginning-of-statement-1 (&optional lim)
|
|
1742 ;; move to the start of the current statement, or the previous
|
|
1743 ;; statement if already at the beginning of one.
|
|
1744 (let ((lim (or lim (point-min)))
|
|
1745 (here (point))
|
|
1746 (pos (point))
|
|
1747 donep)
|
|
1748 ;; go backwards one balanced expression, but be careful of
|
|
1749 ;; unbalanced paren being reached
|
|
1750 (if (not (vhdl-safe (progn (backward-sexp) t)))
|
|
1751 (progn
|
|
1752 (backward-up-list 1)
|
|
1753 (forward-char)
|
|
1754 (vhdl-forward-syntactic-ws here)
|
|
1755 (setq donep t)))
|
|
1756 (while (and (not donep)
|
|
1757 (not (bobp))
|
|
1758 ;; look backwards for a statement boundary
|
|
1759 (re-search-backward vhdl-b-o-s-re lim 'move))
|
|
1760 (if (or (= (preceding-char) ?_)
|
|
1761 (vhdl-in-literal lim))
|
|
1762 (backward-char)
|
|
1763 (cond
|
|
1764 ;; If we are looking at an open paren, then stop after it
|
|
1765 ((eq (following-char) ?\()
|
|
1766 (forward-char)
|
|
1767 (vhdl-forward-syntactic-ws here)
|
|
1768 (setq donep t))
|
|
1769 ;; If we are looking at a close paren, then skip it
|
|
1770 ((eq (following-char) ?\))
|
|
1771 (forward-char)
|
|
1772 (setq pos (point))
|
|
1773 (backward-sexp)
|
|
1774 (if (< (point) lim)
|
|
1775 (progn (goto-char pos)
|
|
1776 (vhdl-forward-syntactic-ws here)
|
|
1777 (setq donep t))))
|
|
1778 ;; If we are looking at a semicolon, then stop
|
|
1779 ((eq (following-char) ?\;)
|
|
1780 (progn
|
|
1781 (forward-char)
|
|
1782 (vhdl-forward-syntactic-ws here)
|
|
1783 (setq donep t)))
|
|
1784 ;; If we are looking at a "begin", then stop
|
|
1785 ((and (looking-at vhdl-begin-fwd-re)
|
|
1786 (/= (preceding-char) ?_)
|
|
1787 (vhdl-begin-p nil))
|
|
1788 ;; If it's a leader "begin", then find the
|
|
1789 ;; right place
|
|
1790 (if (looking-at vhdl-leader-re)
|
|
1791 (save-excursion
|
|
1792 ;; set a default stop point at the begin
|
|
1793 (setq pos (point))
|
|
1794 ;; is the start point inside the leader area ?
|
|
1795 (goto-char (vhdl-end-of-leader))
|
|
1796 (vhdl-forward-syntactic-ws here)
|
|
1797 (if (< (point) here)
|
|
1798 ;; start point was not inside leader area
|
|
1799 ;; set stop point at word after leader
|
|
1800 (setq pos (point))))
|
|
1801 (forward-word 1)
|
|
1802 (vhdl-forward-syntactic-ws here)
|
|
1803 (setq pos (point)))
|
|
1804 (goto-char pos)
|
|
1805 (setq donep t))
|
|
1806 ;; If we are looking at a "statement", then stop
|
|
1807 ((and (looking-at vhdl-statement-fwd-re)
|
|
1808 (/= (preceding-char) ?_)
|
|
1809 (vhdl-statement-p nil))
|
|
1810 (setq donep t))
|
|
1811 ;; If we are looking at a case alternative key, then stop
|
|
1812 ((looking-at vhdl-case-alternative-key)
|
|
1813 (save-excursion
|
|
1814 ;; set a default stop point at the when
|
|
1815 (setq pos (point))
|
|
1816 ;; is the start point inside the case alternative key ?
|
|
1817 (goto-char (match-end 0))
|
|
1818 (vhdl-forward-syntactic-ws here)
|
|
1819 (if (< (point) here)
|
|
1820 ;; start point was not inside the case alternative key
|
|
1821 ;; set stop point at word after case alternative keyleader
|
|
1822 (setq pos (point))))
|
|
1823 (goto-char pos)
|
|
1824 (setq donep t))
|
|
1825 ;; Bogus find, continue
|
|
1826 (t
|
|
1827 (backward-char)))))
|
|
1828 ))
|
|
1829
|
|
1830
|
|
1831 ;; Defuns for calculating the current syntactic state:
|
|
1832
|
|
1833 (defun vhdl-get-library-unit (bod placeholder)
|
|
1834 ;; If there is an enclosing library unit at bod, with it's \"begin\"
|
|
1835 ;; keyword at placeholder, then return the library unit type.
|
|
1836 (let ((here (vhdl-point 'bol)))
|
|
1837 (if (save-excursion
|
|
1838 (goto-char placeholder)
|
|
1839 (vhdl-safe (vhdl-forward-sexp 1 bod))
|
|
1840 (<= here (point)))
|
|
1841 (save-excursion
|
|
1842 (goto-char bod)
|
|
1843 (cond
|
|
1844 ((looking-at "e") 'entity)
|
|
1845 ((looking-at "a") 'architecture)
|
|
1846 ((looking-at "c") 'configuration)
|
|
1847 ((looking-at "p")
|
|
1848 (save-excursion
|
|
1849 (goto-char bod)
|
|
1850 (forward-sexp)
|
|
1851 (vhdl-forward-syntactic-ws here)
|
|
1852 (if (looking-at "body\\b[^_]")
|
|
1853 'package-body 'package))))))
|
|
1854 ))
|
|
1855
|
|
1856 (defun vhdl-get-block-state (&optional lim)
|
|
1857 ;; Finds and records all the closest opens.
|
|
1858 ;; lim is the furthest back we need to search (it should be the
|
|
1859 ;; previous libunit keyword).
|
|
1860 (let ((here (point))
|
|
1861 (lim (or lim (point-min)))
|
|
1862 keyword sexp-start sexp-mid sexp-end
|
|
1863 preceding-sexp containing-sexp
|
|
1864 containing-begin containing-mid containing-paren)
|
|
1865 (save-excursion
|
|
1866 ;; Find the containing-paren, and use that as the limit
|
|
1867 (if (setq containing-paren
|
|
1868 (save-restriction
|
|
1869 (narrow-to-region lim (point))
|
|
1870 (vhdl-safe (scan-lists (point) -1 1))))
|
|
1871 (setq lim containing-paren))
|
|
1872 ;; Look backwards for "begin" and "end" keywords.
|
|
1873 (while (and (> (point) lim)
|
|
1874 (not containing-sexp))
|
|
1875 (setq keyword (vhdl-backward-to-block lim))
|
|
1876 (cond
|
|
1877 ((eq keyword 'begin)
|
|
1878 ;; Found a "begin" keyword
|
|
1879 (setq sexp-start (point))
|
|
1880 (setq sexp-mid (vhdl-corresponding-mid lim))
|
|
1881 (setq sexp-end (vhdl-safe
|
|
1882 (save-excursion
|
|
1883 (vhdl-forward-sexp 1 lim) (point))))
|
|
1884 (if (and sexp-end (<= sexp-end here))
|
|
1885 ;; we want to record this sexp, but we only want to
|
|
1886 ;; record the last-most of any of them before here
|
|
1887 (or preceding-sexp
|
|
1888 (setq preceding-sexp sexp-start))
|
|
1889 ;; we're contained in this sexp so put sexp-start on
|
|
1890 ;; front of list
|
|
1891 (setq containing-sexp sexp-start)
|
|
1892 (setq containing-mid sexp-mid)
|
|
1893 (setq containing-begin t)))
|
|
1894 ((eq keyword 'end)
|
|
1895 ;; Found an "end" keyword
|
|
1896 (forward-sexp)
|
|
1897 (setq sexp-end (point))
|
|
1898 (setq sexp-mid nil)
|
|
1899 (setq sexp-start
|
|
1900 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
|
|
1901 (progn (backward-sexp) (point))))
|
|
1902 ;; we want to record this sexp, but we only want to
|
|
1903 ;; record the last-most of any of them before here
|
|
1904 (or preceding-sexp
|
|
1905 (setq preceding-sexp sexp-start)))
|
|
1906 )))
|
|
1907 ;; Check if the containing-paren should be the containing-sexp
|
|
1908 (if (and containing-paren
|
|
1909 (or (null containing-sexp)
|
|
1910 (< containing-sexp containing-paren)))
|
|
1911 (setq containing-sexp containing-paren
|
|
1912 preceding-sexp nil
|
|
1913 containing-begin nil
|
|
1914 containing-mid nil))
|
|
1915 (vector containing-sexp preceding-sexp containing-begin containing-mid)
|
|
1916 ))
|
|
1917
|
|
1918
|
|
1919 (defconst vhdl-s-c-a-re
|
|
1920 (concat vhdl-case-alternative-key "\\|" vhdl-case-header-key))
|
|
1921
|
|
1922 (defun vhdl-skip-case-alternative (&optional lim)
|
|
1923 ;; skip forward over case/when bodies, with optional maximal
|
|
1924 ;; limit. if no next case alternative is found, nil is returned and point
|
|
1925 ;; is not moved
|
|
1926 (let ((lim (or lim (point-max)))
|
|
1927 (here (point))
|
|
1928 donep foundp)
|
|
1929 (while (and (< (point) lim)
|
|
1930 (not donep))
|
|
1931 (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
|
|
1932 (save-match-data
|
|
1933 (not (vhdl-in-literal)))
|
|
1934 (/= (match-beginning 0) here))
|
|
1935 (progn
|
|
1936 (goto-char (match-beginning 0))
|
|
1937 (cond
|
|
1938 ((and (looking-at "case")
|
|
1939 (re-search-forward "\\bis[^_]" lim t))
|
|
1940 (backward-sexp)
|
|
1941 (vhdl-forward-sexp))
|
|
1942 (t
|
|
1943 (setq donep t
|
|
1944 foundp t))))))
|
|
1945 (if (not foundp)
|
|
1946 (goto-char here))
|
|
1947 foundp))
|
|
1948
|
|
1949 (defun vhdl-backward-skip-label (&optional lim)
|
|
1950 ;; skip backward over a label, with optional maximal
|
|
1951 ;; limit. if label is found, nil is returned and point
|
|
1952 ;; is not moved
|
|
1953 (let ((lim (or lim (point-min)))
|
|
1954 placeholder)
|
|
1955 (if (save-excursion
|
|
1956 (vhdl-backward-syntactic-ws lim)
|
|
1957 (and (eq (preceding-char) ?:)
|
|
1958 (progn
|
|
1959 (backward-sexp)
|
|
1960 (setq placeholder (point))
|
|
1961 (looking-at vhdl-label-key))))
|
|
1962 (goto-char placeholder))
|
|
1963 ))
|
|
1964
|
|
1965 (defun vhdl-get-syntactic-context ()
|
|
1966 ;; guess the syntactic description of the current line of VHDL code.
|
|
1967 (save-excursion
|
|
1968 (save-restriction
|
|
1969 (beginning-of-line)
|
|
1970 (let* ((indent-point (point))
|
|
1971 (case-fold-search t)
|
|
1972 vec literal containing-sexp preceding-sexp
|
|
1973 containing-begin containing-mid containing-leader
|
|
1974 char-before-ip char-after-ip begin-after-ip end-after-ip
|
|
1975 placeholder lim library-unit
|
|
1976 )
|
|
1977
|
|
1978 ;; Reset the syntactic context
|
|
1979 (setq vhdl-syntactic-context nil)
|
|
1980
|
|
1981 (save-excursion
|
|
1982 ;; Move to the start of the previous library unit, and
|
|
1983 ;; record the position of the "begin" keyword.
|
|
1984 (setq placeholder (vhdl-beginning-of-libunit))
|
|
1985 ;; The position of the "libunit" keyword gives us a gross
|
|
1986 ;; limit point.
|
|
1987 (setq lim (point))
|
|
1988 )
|
|
1989
|
|
1990 ;; If there is a previous library unit, and we are enclosed by
|
|
1991 ;; it, then set the syntax accordingly.
|
|
1992 (and placeholder
|
|
1993 (setq library-unit (vhdl-get-library-unit lim placeholder))
|
|
1994 (vhdl-add-syntax library-unit lim))
|
|
1995
|
|
1996 ;; Find the surrounding state.
|
|
1997 (if (setq vec (vhdl-get-block-state lim))
|
|
1998 (progn
|
|
1999 (setq containing-sexp (aref vec 0))
|
|
2000 (setq preceding-sexp (aref vec 1))
|
|
2001 (setq containing-begin (aref vec 2))
|
|
2002 (setq containing-mid (aref vec 3))
|
|
2003 ))
|
|
2004
|
|
2005 ;; set the limit on the farthest back we need to search
|
|
2006 (setq lim (if containing-sexp
|
|
2007 (save-excursion
|
|
2008 (goto-char containing-sexp)
|
|
2009 ;; set containing-leader if required
|
|
2010 (if (looking-at vhdl-leader-re)
|
|
2011 (setq containing-leader (vhdl-end-of-leader)))
|
|
2012 (vhdl-point 'bol))
|
|
2013 (point-min)))
|
|
2014
|
|
2015 ;; cache char before and after indent point, and move point to
|
|
2016 ;; the most likely position to perform the majority of tests
|
|
2017 (goto-char indent-point)
|
|
2018 (skip-chars-forward " \t")
|
|
2019 (setq literal (vhdl-in-literal lim))
|
|
2020 (setq char-after-ip (following-char))
|
|
2021 (setq begin-after-ip (and
|
|
2022 (not literal)
|
|
2023 (looking-at vhdl-begin-fwd-re)
|
|
2024 (vhdl-begin-p)))
|
|
2025 (setq end-after-ip (and
|
|
2026 (not literal)
|
|
2027 (looking-at vhdl-end-fwd-re)
|
|
2028 (vhdl-end-p)))
|
|
2029 (vhdl-backward-syntactic-ws lim)
|
|
2030 (setq char-before-ip (preceding-char))
|
|
2031 (goto-char indent-point)
|
|
2032 (skip-chars-forward " \t")
|
|
2033
|
|
2034 ;; now figure out syntactic qualities of the current line
|
|
2035 (cond
|
|
2036 ;; CASE 1: in a string or comment.
|
|
2037 ((memq literal '(string comment))
|
|
2038 (vhdl-add-syntax literal (vhdl-point 'bopl)))
|
|
2039 ;; CASE 2: Line is at top level.
|
|
2040 ((null containing-sexp)
|
|
2041 ;; Find the point to which indentation will be relative
|
|
2042 (save-excursion
|
|
2043 (if (null preceding-sexp)
|
|
2044 ;; CASE 2X.1
|
|
2045 ;; no preceding-sexp -> use the preceding statement
|
|
2046 (vhdl-beginning-of-statement-1 lim)
|
|
2047 ;; CASE 2X.2
|
|
2048 ;; if there is a preceding-sexp then indent relative to it
|
|
2049 (goto-char preceding-sexp)
|
|
2050 ;; if not at boi, then the block-opening keyword is
|
|
2051 ;; probably following a label, so we need a different
|
|
2052 ;; relpos
|
|
2053 (if (/= (point) (vhdl-point 'boi))
|
|
2054 ;; CASE 2X.3
|
|
2055 (vhdl-beginning-of-statement-1 lim)))
|
|
2056 ;; v-b-o-s could have left us at point-min
|
|
2057 (and (bobp)
|
|
2058 ;; CASE 2X.4
|
|
2059 (vhdl-forward-syntactic-ws indent-point))
|
|
2060 (setq placeholder (point)))
|
|
2061 (cond
|
|
2062 ;; CASE 2A : we are looking at a block-open
|
|
2063 (begin-after-ip
|
|
2064 (vhdl-add-syntax 'block-open placeholder))
|
|
2065 ;; CASE 2B: we are looking at a block-close
|
|
2066 (end-after-ip
|
|
2067 (vhdl-add-syntax 'block-close placeholder))
|
|
2068 ;; CASE 2C: we are looking at a top-level statement
|
|
2069 ((progn
|
|
2070 (vhdl-backward-syntactic-ws lim)
|
|
2071 (or (bobp)
|
|
2072 (= (preceding-char) ?\;)))
|
|
2073 (vhdl-add-syntax 'statement placeholder))
|
|
2074 ;; CASE 2D: we are looking at a top-level statement-cont
|
|
2075 (t
|
|
2076 (vhdl-beginning-of-statement-1 lim)
|
|
2077 ;; v-b-o-s could have left us at point-min
|
|
2078 (and (bobp)
|
|
2079 ;; CASE 2D.1
|
|
2080 (vhdl-forward-syntactic-ws indent-point))
|
|
2081 (vhdl-add-syntax 'statement-cont (point)))
|
|
2082 )) ; end CASE 2
|
|
2083 ;; CASE 3: line is inside parentheses. Most likely we are
|
|
2084 ;; either in a subprogram argument (interface) list, or a
|
|
2085 ;; continued expression containing parentheses.
|
|
2086 ((null containing-begin)
|
|
2087 (vhdl-backward-syntactic-ws containing-sexp)
|
|
2088 (cond
|
|
2089 ;; CASE 3A: we are looking at the arglist closing paren
|
|
2090 ((eq char-after-ip ?\))
|
|
2091 (goto-char containing-sexp)
|
|
2092 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
|
|
2093 ;; CASE 3B: we are looking at the first argument in an empty
|
|
2094 ;; argument list.
|
|
2095 ((eq char-before-ip ?\()
|
|
2096 (goto-char containing-sexp)
|
|
2097 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
|
|
2098 ;; CASE 3C: we are looking at an arglist continuation line,
|
|
2099 ;; but the preceding argument is on the same line as the
|
|
2100 ;; opening paren. This case includes multi-line
|
|
2101 ;; expression paren groupings.
|
|
2102 ((and (save-excursion
|
|
2103 (goto-char (1+ containing-sexp))
|
|
2104 (skip-chars-forward " \t")
|
|
2105 (not (eolp))
|
|
2106 (not (looking-at "--")))
|
|
2107 (save-excursion
|
|
2108 (vhdl-beginning-of-statement-1 containing-sexp)
|
|
2109 (skip-chars-backward " \t(")
|
|
2110 (<= (point) containing-sexp)))
|
|
2111 (goto-char containing-sexp)
|
|
2112 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
|
|
2113 ;; CASE 3D: we are looking at just a normal arglist
|
|
2114 ;; continuation line
|
|
2115 (t (vhdl-beginning-of-statement-1 containing-sexp)
|
|
2116 (vhdl-forward-syntactic-ws indent-point)
|
|
2117 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
|
|
2118 ))
|
|
2119 ;; CASE 4: A block mid open
|
|
2120 ((and begin-after-ip
|
|
2121 (looking-at containing-mid))
|
|
2122 (goto-char containing-sexp)
|
|
2123 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
|
|
2124 (if (looking-at vhdl-trailer-re)
|
|
2125 ;; CASE 4.1
|
|
2126 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
|
|
2127 (vhdl-backward-skip-label (vhdl-point 'boi))
|
|
2128 (vhdl-add-syntax 'block-open (point)))
|
|
2129 ;; CASE 5: block close brace
|
|
2130 (end-after-ip
|
|
2131 (goto-char containing-sexp)
|
|
2132 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
|
|
2133 (if (looking-at vhdl-trailer-re)
|
|
2134 ;; CASE 5.1
|
|
2135 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
|
|
2136 (vhdl-backward-skip-label (vhdl-point 'boi))
|
|
2137 (vhdl-add-syntax 'block-close (point)))
|
|
2138 ;; CASE 6: A continued statement
|
|
2139 ((and (/= char-before-ip ?\;)
|
|
2140 ;; check it's not a trailer begin keyword, or a begin
|
|
2141 ;; keyword immediately following a label.
|
|
2142 (not (and begin-after-ip
|
|
2143 (or (looking-at vhdl-trailer-re)
|
|
2144 (save-excursion
|
|
2145 (vhdl-backward-skip-label containing-sexp)))))
|
|
2146 ;; check it's not a statement keyword
|
|
2147 (not (and (looking-at vhdl-statement-fwd-re)
|
|
2148 (vhdl-statement-p)))
|
|
2149 ;; see if the b-o-s is before the indent point
|
|
2150 (> indent-point
|
|
2151 (save-excursion
|
|
2152 (vhdl-beginning-of-statement-1 containing-sexp)
|
|
2153 ;; If we ended up after a leader, then this will
|
|
2154 ;; move us forward to the start of the first
|
|
2155 ;; statement. Note that a containing sexp here is
|
|
2156 ;; always a keyword, not a paren, so this will
|
|
2157 ;; have no effect if we hit the containing-sexp.
|
|
2158 (vhdl-forward-syntactic-ws indent-point)
|
|
2159 (setq placeholder (point))))
|
|
2160 ;; check it's not a block-intro
|
|
2161 (/= placeholder containing-sexp)
|
|
2162 ;; check it's not a case block-intro
|
|
2163 (save-excursion
|
|
2164 (goto-char placeholder)
|
|
2165 (or (not (looking-at vhdl-case-alternative-key))
|
|
2166 (> (match-end 0) indent-point))))
|
|
2167 (vhdl-add-syntax 'statement-cont placeholder)
|
|
2168 (if begin-after-ip
|
|
2169 (vhdl-add-syntax 'block-open)))
|
|
2170 ;; Statement. But what kind?
|
|
2171 ;; CASE 7: A case alternative key
|
|
2172 ((looking-at vhdl-case-alternative-key)
|
|
2173 ;; for a case alternative key, we set relpos to the first
|
|
2174 ;; non-whitespace char on the line containing the "case"
|
|
2175 ;; keyword.
|
|
2176 (goto-char containing-sexp)
|
|
2177 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
|
|
2178 (if (looking-at vhdl-trailer-re)
|
|
2179 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
|
|
2180 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
|
|
2181 ;; CASE 8: statement catchall
|
|
2182 (t
|
|
2183 ;; we know its a statement, but we need to find out if it is
|
|
2184 ;; the first statement in a block
|
|
2185 (if containing-leader
|
|
2186 (goto-char containing-leader)
|
|
2187 (goto-char containing-sexp)
|
|
2188 ;; Note that a containing sexp here is always a keyword,
|
|
2189 ;; not a paren, so skip over the keyword.
|
|
2190 (forward-sexp))
|
|
2191 ;; move to the start of the first statement
|
|
2192 (vhdl-forward-syntactic-ws indent-point)
|
|
2193 (setq placeholder (point))
|
|
2194 ;; we want to ignore case alternatives keys when skipping forward
|
|
2195 (let (incase-p)
|
|
2196 (while (looking-at vhdl-case-alternative-key)
|
|
2197 (setq incase-p (point))
|
|
2198 ;; we also want to skip over the body of the
|
|
2199 ;; case/when statement if that doesn't put us at
|
|
2200 ;; after the indent-point
|
|
2201 (while (vhdl-skip-case-alternative indent-point))
|
|
2202 ;; set up the match end
|
|
2203 (looking-at vhdl-case-alternative-key)
|
|
2204 (goto-char (match-end 0))
|
|
2205 ;; move to the start of the first case alternative statement
|
|
2206 (vhdl-forward-syntactic-ws indent-point)
|
|
2207 (setq placeholder (point)))
|
|
2208 (cond
|
|
2209 ;; CASE 8A: we saw a case/when statement so we must be
|
|
2210 ;; in a switch statement. find out if we are at the
|
|
2211 ;; statement just after a case alternative key
|
|
2212 ((and incase-p
|
|
2213 (= (point) indent-point))
|
|
2214 ;; relpos is the "when" keyword
|
|
2215 (vhdl-add-syntax 'statement-case-intro incase-p))
|
|
2216 ;; CASE 8B: any old statement
|
|
2217 ((< (point) indent-point)
|
|
2218 ;; relpos is the first statement of the block
|
|
2219 (vhdl-add-syntax 'statement placeholder)
|
|
2220 (if begin-after-ip
|
|
2221 (vhdl-add-syntax 'block-open)))
|
|
2222 ;; CASE 8C: first statement in a block
|
|
2223 (t
|
|
2224 (goto-char containing-sexp)
|
|
2225 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
|
|
2226 (if (looking-at vhdl-trailer-re)
|
|
2227 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
|
|
2228 (vhdl-backward-skip-label (vhdl-point 'boi))
|
|
2229 (vhdl-add-syntax 'statement-block-intro (point))
|
|
2230 (if begin-after-ip
|
|
2231 (vhdl-add-syntax 'block-open)))
|
|
2232 )))
|
|
2233 )
|
|
2234
|
|
2235 ;; now we need to look at any modifiers
|
|
2236 (goto-char indent-point)
|
|
2237 (skip-chars-forward " \t")
|
|
2238 (if (looking-at "--")
|
|
2239 (vhdl-add-syntax 'comment))
|
|
2240 ;; return the syntax
|
|
2241 vhdl-syntactic-context))))
|
|
2242
|
|
2243
|
|
2244 ;; Standard indentation line-ups:
|
|
2245
|
|
2246 (defun vhdl-lineup-arglist (langelem)
|
|
2247 ;; lineup the current arglist line with the arglist appearing just
|
|
2248 ;; after the containing paren which starts the arglist.
|
|
2249 (save-excursion
|
|
2250 (let* ((containing-sexp
|
|
2251 (save-excursion
|
|
2252 ;; arglist-cont-nonempty gives relpos ==
|
|
2253 ;; to boi of containing-sexp paren. This
|
|
2254 ;; is good when offset is +, but bad
|
|
2255 ;; when it is vhdl-lineup-arglist, so we
|
|
2256 ;; have to special case a kludge here.
|
|
2257 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
|
|
2258 (progn
|
|
2259 (beginning-of-line)
|
|
2260 (backward-up-list 1)
|
|
2261 (skip-chars-forward " \t" (vhdl-point 'eol)))
|
|
2262 (goto-char (cdr langelem)))
|
|
2263 (point)))
|
|
2264 (cs-curcol (save-excursion
|
|
2265 (goto-char (cdr langelem))
|
|
2266 (current-column))))
|
|
2267 (if (save-excursion
|
|
2268 (beginning-of-line)
|
|
2269 (looking-at "[ \t]*)"))
|
|
2270 (progn (goto-char (match-end 0))
|
|
2271 (backward-sexp)
|
|
2272 (forward-char)
|
|
2273 (vhdl-forward-syntactic-ws)
|
|
2274 (- (current-column) cs-curcol))
|
|
2275 (goto-char containing-sexp)
|
|
2276 (or (eolp)
|
|
2277 (let ((eol (vhdl-point 'eol))
|
|
2278 (here (progn
|
|
2279 (forward-char)
|
|
2280 (skip-chars-forward " \t")
|
|
2281 (point))))
|
|
2282 (vhdl-forward-syntactic-ws)
|
|
2283 (if (< (point) eol)
|
|
2284 (goto-char here))))
|
|
2285 (- (current-column) cs-curcol)
|
|
2286 ))))
|
|
2287
|
|
2288 (defun vhdl-lineup-arglist-intro (langelem)
|
|
2289 ;; lineup an arglist-intro line to just after the open paren
|
|
2290 (save-excursion
|
|
2291 (let ((cs-curcol (save-excursion
|
|
2292 (goto-char (cdr langelem))
|
|
2293 (current-column)))
|
|
2294 (ce-curcol (save-excursion
|
|
2295 (beginning-of-line)
|
|
2296 (backward-up-list 1)
|
|
2297 (skip-chars-forward " \t" (vhdl-point 'eol))
|
|
2298 (current-column))))
|
|
2299 (- ce-curcol cs-curcol -1))))
|
|
2300
|
|
2301 (defun vhdl-lineup-comment (langelem)
|
|
2302 ;; support old behavior for comment indentation. we look at
|
|
2303 ;; vhdl-comment-only-line-offset to decide how to indent comment
|
|
2304 ;; only-lines
|
|
2305 (save-excursion
|
|
2306 (back-to-indentation)
|
|
2307 ;; at or to the right of comment-column
|
|
2308 (if (>= (current-column) comment-column)
|
|
2309 (vhdl-comment-indent)
|
|
2310 ;; otherwise, indent as specified by vhdl-comment-only-line-offset
|
|
2311 (if (not (bolp))
|
|
2312 (or (car-safe vhdl-comment-only-line-offset)
|
|
2313 vhdl-comment-only-line-offset)
|
|
2314 (or (cdr-safe vhdl-comment-only-line-offset)
|
|
2315 (car-safe vhdl-comment-only-line-offset)
|
|
2316 -1000 ;jam it against the left side
|
|
2317 )))))
|
|
2318
|
|
2319 (defun vhdl-lineup-statement-cont (langelem)
|
|
2320 ;; line up statement-cont after the assignment operator
|
|
2321 (save-excursion
|
|
2322 (let* ((relpos (cdr langelem))
|
|
2323 (assignp (save-excursion
|
|
2324 (goto-char (vhdl-point 'boi))
|
|
2325 (and (re-search-forward "\\(<\\|:\\)="
|
|
2326 (vhdl-point 'eol) t)
|
|
2327 (- (point) (vhdl-point 'boi)))))
|
|
2328 (curcol (progn
|
|
2329 (goto-char relpos)
|
|
2330 (current-column)))
|
|
2331 foundp)
|
|
2332 (while (and (not foundp)
|
|
2333 (< (point) (vhdl-point 'eol)))
|
|
2334 (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
|
|
2335 (if (vhdl-in-literal (cdr langelem))
|
|
2336 (forward-char)
|
|
2337 (if (= (preceding-char) ?\()
|
|
2338 ;; skip over any parenthesized expressions
|
|
2339 (goto-char (min (vhdl-point 'eol)
|
|
2340 (scan-lists (point) 1 1)))
|
|
2341 ;; found an assignment operator (not at eol)
|
|
2342 (setq foundp (not (looking-at "\\s-*$"))))))
|
|
2343 (if (not foundp)
|
|
2344 ;; there's no assignment operator on the line
|
|
2345 vhdl-basic-offset
|
|
2346 ;; calculate indentation column after assign and ws, unless
|
|
2347 ;; our line contains an assignment operator
|
|
2348 (if (not assignp)
|
|
2349 (progn
|
|
2350 (forward-char)
|
|
2351 (skip-chars-forward " \t")
|
|
2352 (setq assignp 0)))
|
|
2353 (- (current-column) assignp curcol))
|
|
2354 )))
|
|
2355
|
|
2356
|
|
2357 ;; Indentation commands:
|
|
2358
|
|
2359 ;; This is used by indent-for-comment to decide how much to indent a
|
|
2360 ;; comment in VHDL code based on its context.
|
|
2361 (defun vhdl-comment-indent ()
|
|
2362 (if (looking-at (concat "^--"))
|
|
2363 0 ;Existing comment at bol stays there.
|
|
2364 (let ((opoint (point))
|
|
2365 placeholder)
|
|
2366 (save-excursion
|
|
2367 (beginning-of-line)
|
|
2368 (cond
|
|
2369 ;; CASE 1: use comment-column if previous line is a
|
|
2370 ;; comment-only line indented to the left of comment-column
|
|
2371 ((save-excursion
|
|
2372 (beginning-of-line)
|
|
2373 (and (not (bobp))
|
|
2374 (forward-line -1))
|
|
2375 (skip-chars-forward " \t")
|
|
2376 (prog1
|
|
2377 (looking-at "--")
|
|
2378 (setq placeholder (point))))
|
|
2379 (goto-char placeholder)
|
|
2380 (if (< (current-column) comment-column)
|
|
2381 comment-column
|
|
2382 (current-column)))
|
|
2383 ;; CASE 2: If comment-column is 0, and nothing but space
|
|
2384 ;; before the comment, align it at 0 rather than 1.
|
|
2385 ((progn
|
|
2386 (goto-char opoint)
|
|
2387 (skip-chars-backward " \t")
|
|
2388 (and (= comment-column 0) (bolp)))
|
|
2389 0)
|
|
2390 ;; CASE 3: indent at comment column except leave at least one
|
|
2391 ;; space.
|
|
2392 (t (max (1+ (current-column))
|
|
2393 comment-column))
|
|
2394 )))))
|
|
2395
|
|
2396 (defun vhdl-indent-line ()
|
|
2397 ;; indent the current line as VHDL code. Returns the amount of
|
|
2398 ;; indentation change
|
|
2399 (let* ((syntax (vhdl-get-syntactic-context))
|
|
2400 (pos (- (point-max) (point)))
|
|
2401 (indent (apply '+ (mapcar 'vhdl-get-offset syntax)))
|
|
2402 (shift-amt (- (current-indentation) indent)))
|
|
2403 (and vhdl-echo-syntactic-information-p
|
|
2404 (message "syntax: %s, indent= %d" syntax indent))
|
|
2405 (if (zerop shift-amt)
|
|
2406 nil
|
|
2407 (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
|
|
2408 (beginning-of-line)
|
|
2409 (indent-to indent))
|
|
2410 (if (< (point) (vhdl-point 'boi))
|
|
2411 (back-to-indentation)
|
|
2412 ;; If initial point was within line's indentation, position after
|
|
2413 ;; the indentation. Else stay at same point in text.
|
|
2414 (if (> (- (point-max) pos) (point))
|
|
2415 (goto-char (- (point-max) pos)))
|
|
2416 )
|
|
2417 (run-hooks 'vhdl-special-indent-hook)
|
|
2418 shift-amt))
|
|
2419
|
|
2420 (defun vhdl-indent-command (&optional whole-exp)
|
|
2421 "Indent current line as VHDL code, or in some cases insert a tab character.
|
|
2422
|
|
2423 If `vhdl-tab-always-indent' is t, always just indent the current line.
|
|
2424 If nil, indent the current line only if point is at the left margin or
|
|
2425 in the line's indentation; otherwise insert a tab. If other than nil
|
|
2426 or t, then tab is inserted only within literals (comments and strings)
|
|
2427 and inside preprocessor directives, but line is always reindented.
|
|
2428
|
|
2429 A numeric argument, regardless of its value, means indent rigidly all
|
|
2430 the lines of the expression starting after point so that this line
|
|
2431 becomes properly indented. The relative indentation among the lines
|
|
2432 of the expression are preserved."
|
|
2433 (interactive "P")
|
|
2434 (if whole-exp
|
|
2435 ;; If arg, always indent this line as VHDL
|
|
2436 ;; and shift remaining lines of expression the same amount.
|
|
2437 (let ((shift-amt (vhdl-indent-line))
|
|
2438 beg end)
|
|
2439 (save-excursion
|
|
2440 (if (eq vhdl-tab-always-indent t)
|
|
2441 (beginning-of-line))
|
|
2442 (setq beg (point))
|
|
2443 (forward-sexp)
|
|
2444 (setq end (point))
|
|
2445 (goto-char beg)
|
|
2446 (forward-line 1)
|
|
2447 (setq beg (point)))
|
|
2448 (if (> end beg)
|
|
2449 (indent-code-rigidly beg end (- shift-amt))))
|
|
2450 ;; No arg supplied, use vhdl-tab-always-indent to determine
|
|
2451 ;; behavior
|
|
2452 (cond
|
|
2453 ;; CASE 1: indent when at column zero or in lines indentation,
|
|
2454 ;; otherwise insert a tab
|
|
2455 ((not vhdl-tab-always-indent)
|
|
2456 (if (save-excursion
|
|
2457 (skip-chars-backward " \t")
|
|
2458 (not (bolp)))
|
|
2459 (insert-tab)
|
|
2460 (vhdl-indent-line)))
|
|
2461 ;; CASE 2: just indent the line
|
|
2462 ((eq vhdl-tab-always-indent t)
|
|
2463 (vhdl-indent-line))
|
|
2464 ;; CASE 3: if in a literal, insert a tab, but always indent the
|
|
2465 ;; line
|
|
2466 (t
|
|
2467 (if (vhdl-in-literal (vhdl-point 'bod))
|
|
2468 (insert-tab))
|
|
2469 (vhdl-indent-line)
|
|
2470 ))))
|
|
2471
|
|
2472 (defun vhdl-indent-sexp (&optional endpos)
|
|
2473 "Indent each line of the list starting just after point.
|
|
2474 If optional arg ENDPOS is given, indent each line, stopping when
|
|
2475 ENDPOS is encountered. (interactive)"
|
|
2476 (interactive)
|
|
2477 (save-excursion
|
|
2478 (let ((beg (point))
|
|
2479 (end (progn
|
|
2480 (vhdl-forward-sexp nil endpos)
|
|
2481 (point))))
|
|
2482 (indent-region beg end nil))))
|
|
2483
|
|
2484 (defun vhdl-show-syntactic-information ()
|
|
2485 "Show syntactic information for current line."
|
|
2486 (interactive)
|
|
2487 (message "syntactic analysis: %s" (vhdl-get-syntactic-context))
|
|
2488 (vhdl-keep-region-active))
|
|
2489
|
|
2490
|
|
2491 ;; Verification and regression functions:
|
|
2492
|
|
2493 (defun vhdl-regress-line (&optional arg)
|
|
2494 "Check syntactic information for current line."
|
|
2495 (interactive "P")
|
|
2496 (let ((expected (save-excursion
|
|
2497 (end-of-line)
|
|
2498 (if (search-backward " -- ((" (vhdl-point 'bol) t)
|
|
2499 (progn
|
|
2500 (forward-char 4)
|
|
2501 (read (current-buffer))))))
|
|
2502 (actual (vhdl-get-syntactic-context))
|
|
2503 (expurgated))
|
|
2504 ;; remove the library unit symbols
|
|
2505 (mapcar
|
|
2506 (function
|
|
2507 (lambda (elt)
|
|
2508 (if (memq (car elt) '(entity configuration package
|
|
2509 package-body architecture))
|
|
2510 nil
|
|
2511 (setq expurgated (append expurgated (list elt))))))
|
|
2512 actual)
|
|
2513 (if (and (not arg) expected (listp expected))
|
|
2514 (if (not (equal expected expurgated))
|
|
2515 (error "Should be: %s, is: %s" expected expurgated))
|
|
2516 (save-excursion
|
|
2517 (beginning-of-line)
|
|
2518 (if (not (looking-at "^\\s-*\\(--.*\\)?$"))
|
|
2519 (progn
|
|
2520 (end-of-line)
|
|
2521 (if (search-backward " -- ((" (vhdl-point 'bol) t)
|
|
2522 (kill-line))
|
|
2523 (insert " -- ")
|
|
2524 (insert (format "%s" expurgated)))))))
|
|
2525 (vhdl-keep-region-active))
|
|
2526
|
|
2527 (defun test-vhdl-get-block-state ()
|
|
2528 (interactive)
|
|
2529 (let ((case-fold-search t)
|
|
2530 here vec (delay 0.5))
|
|
2531 (setq here (point))
|
|
2532 (message "%s" (prin1-to-string (setq vec (vhdl-get-block-state))))
|
|
2533 (and (aref vec 0)
|
|
2534 (goto-char (aref vec 0))
|
|
2535 (sit-for delay))
|
|
2536 (and (aref vec 1)
|
|
2537 (goto-char (aref vec 1))
|
|
2538 (sit-for delay))
|
|
2539 (goto-char here)
|
|
2540 ))
|
|
2541
|
|
2542 ;; Support for Barry Warsaw's elp (emacs lisp profiler) package:
|
|
2543
|
|
2544 (setq elp-all-instrumented-list nil)
|
|
2545 (setq elp-function-list
|
|
2546 '(
|
|
2547 vhdl-indent-command
|
|
2548 vhdl-indent-line
|
|
2549 vhdl-comment-indent
|
|
2550 vhdl-lineup-statement-cont
|
|
2551 vhdl-lineup-comment
|
|
2552 vhdl-lineup-arglist-intro
|
|
2553 vhdl-lineup-arglist
|
|
2554 vhdl-get-syntactic-context
|
|
2555 vhdl-skip-case-alternative
|
|
2556 vhdl-get-block-state
|
|
2557 vhdl-get-library-unit
|
|
2558 vhdl-beginning-of-statement
|
|
2559 vhdl-beginning-of-statement-1
|
|
2560 vhdl-beginning-of-defun
|
|
2561 vhdl-beginning-of-libunit
|
|
2562 vhdl-backward-sexp
|
|
2563 vhdl-forward-sexp
|
|
2564 vhdl-backward-to-block
|
|
2565 vhdl-statement-p
|
|
2566 vhdl-end-of-leader
|
|
2567 vhdl-corresponding-begin
|
|
2568 vhdl-end-p
|
|
2569 vhdl-corresponding-end
|
|
2570 vhdl-corresponding-mid
|
|
2571 vhdl-begin-p
|
|
2572 vhdl-corresponding-defun
|
|
2573 vhdl-defun-p
|
|
2574 vhdl-libunit-p
|
|
2575 vhdl-last-word
|
|
2576 vhdl-first-word
|
|
2577 vhdl-backward-syntactic-ws
|
|
2578 vhdl-forward-syntactic-ws
|
|
2579 vhdl-in-literal
|
|
2580 vhdl-keep-region-active
|
|
2581 ))
|
|
2582
|
|
2583 ;; (elp-instrument-list elp-function-list)
|
|
2584
|
|
2585 (defun vhdl-trace-all-functions ()
|
|
2586 (interactive)
|
|
2587 (let ((list elp-function-list))
|
|
2588 (while list
|
|
2589 (trace-function-background (car list))
|
|
2590 (setq list (cdr list)))))
|
|
2591
|
|
2592
|
|
2593 ;; Defuns for submitting bug reports:
|
|
2594
|
161
|
2595 (defconst vhdl-version "$Revision: 1.5 $"
|
72
|
2596 "vhdl-mode version number.")
|
|
2597 (defconst vhdl-mode-help-address "rwhitby@asc.corp.mot.com"
|
|
2598 "Address accepting submission of bug reports.")
|
|
2599
|
|
2600 (defun vhdl-version ()
|
|
2601 "Echo the current version of vhdl-mode in the minibuffer."
|
|
2602 (interactive)
|
|
2603 (message "Using vhdl-mode %s" vhdl-version)
|
|
2604 (vhdl-keep-region-active))
|
|
2605
|
|
2606 ;; get reporter-submit-bug-report when byte-compiling
|
|
2607 (and (fboundp 'eval-when-compile)
|
|
2608 (eval-when-compile
|
|
2609 (require 'reporter)))
|
|
2610
|
|
2611 (defun vhdl-submit-bug-report ()
|
|
2612 "Submit via mail a bug report on vhdl-mode."
|
|
2613 (interactive)
|
|
2614 ;; load in reporter
|
|
2615 (and
|
|
2616 (y-or-n-p "Do you want to submit a report on vhdl-mode? ")
|
|
2617 (require 'reporter)
|
|
2618 (reporter-submit-bug-report
|
|
2619 vhdl-mode-help-address
|
|
2620 (concat "vhdl-mode " vhdl-version)
|
|
2621 (list
|
|
2622 ;; report only the vars that affect indentation
|
|
2623 'vhdl-basic-offset
|
|
2624 'vhdl-offsets-alist
|
|
2625 'vhdl-comment-only-line-offset
|
|
2626 'vhdl-tab-always-indent
|
|
2627 'tab-width
|
|
2628 )
|
|
2629 (function
|
|
2630 (lambda ()
|
|
2631 (insert
|
|
2632 (if vhdl-special-indent-hook
|
|
2633 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
|
|
2634 "vhdl-special-indent-hook is set to '"
|
|
2635 (format "%s" vhdl-special-indent-hook)
|
|
2636 ".\nPerhaps this is your problem?\n"
|
|
2637 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
|
|
2638 "\n")
|
|
2639 (format "vhdl-emacs-features: %s\n" vhdl-emacs-features)
|
|
2640 )))
|
|
2641 nil
|
|
2642 "Dear Rod,"
|
|
2643 )))
|
|
2644
|
|
2645 (provide 'vhdl-mode)
|
|
2646 ;;; vhdl-mode.el ends here
|