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