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