summaryrefslogtreecommitdiff
path: root/lisp/progmodes
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/progmodes')
-rw-r--r--lisp/progmodes/cap-words.el98
-rw-r--r--lisp/progmodes/cc-engine.el3
-rw-r--r--lisp/progmodes/compile.el56
-rw-r--r--lisp/progmodes/cwarn.el2
-rw-r--r--lisp/progmodes/f90.el2
-rw-r--r--lisp/progmodes/grep.el31
-rw-r--r--lisp/progmodes/hideif.el17
-rw-r--r--lisp/progmodes/hideshow.el1
-rw-r--r--lisp/progmodes/idlw-help.el16
-rw-r--r--lisp/progmodes/perl-mode.el43
-rw-r--r--lisp/progmodes/prog-mode.el2
-rw-r--r--lisp/progmodes/prolog.el2
-rw-r--r--lisp/progmodes/ps-mode.el340
-rw-r--r--lisp/progmodes/python.el24
-rw-r--r--lisp/progmodes/scheme.el24
-rw-r--r--lisp/progmodes/sh-script.el61
-rw-r--r--lisp/progmodes/subword.el125
-rw-r--r--lisp/progmodes/vera-mode.el6
-rw-r--r--lisp/progmodes/verilog-mode.el188
-rw-r--r--lisp/progmodes/vhdl-mode.el820
-rw-r--r--lisp/progmodes/xscheme.el37
21 files changed, 964 insertions, 934 deletions
diff --git a/lisp/progmodes/cap-words.el b/lisp/progmodes/cap-words.el
deleted file mode 100644
index b03daf4cd5a..00000000000
--- a/lisp/progmodes/cap-words.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; cap-words.el --- minor mode for motion in CapitalizedWordIdentifiers
-
-;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
-
-;; Author: Dave Love <fx@gnu.org>
-;; Keywords: languages
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Provides Capitalized Words minor mode for word movement in
-;; identifiers CapitalizedLikeThis.
-
-;; Note that the same effect could be obtained by frobbing the
-;; category of upper case characters to produce word boundaries, but
-;; the necessary processing isn't done for ASCII characters.
-
-;; Fixme: This doesn't work properly for mouse double clicks.
-
-;;; Code:
-
-(defun capitalized-find-word-boundary (pos limit)
- "Function for use in `find-word-boundary-function-table'.
-Looks for word boundaries before capitals."
- (save-excursion
- (goto-char pos)
- (let (case-fold-search)
- (if (<= pos limit)
- ;; Fixme: Are these regexps the best?
- (or (and (re-search-forward "\\=.\\w*[[:upper:]]"
- limit t)
- (progn (backward-char)
- t))
- (re-search-forward "\\>" limit t))
- (or (re-search-backward "[[:upper:]]\\w*\\=" limit t)
- (re-search-backward "\\<" limit t))))
- (point)))
-
-
-(defconst capitalized-find-word-boundary-function-table
- (let ((tab (make-char-table nil)))
- (set-char-table-range tab t #'capitalized-find-word-boundary)
- tab)
- "Assigned to `find-word-boundary-function-table' in Capitalized Words mode.")
-
-;;;###autoload
-(define-minor-mode capitalized-words-mode
- "Toggle Capitalized Words mode.
-With a prefix argument ARG, enable Capitalized Words mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
-
-Capitalized Words mode is a buffer-local minor mode. When
-enabled, a word boundary occurs immediately before an uppercase
-letter in a symbol. This is in addition to all the normal
-boundaries given by the syntax and category tables. There is no
-restriction to ASCII.
-
-E.g. the beginning of words in the following identifier are as marked:
-
- capitalizedWorDD
- ^ ^ ^^
-
-Note that these word boundaries only apply for word motion and
-marking commands such as \\[forward-word]. This mode does not affect word
-boundaries found by regexp matching (`\\>', `\\w' &c).
-
-This style of identifiers is common in environments like Java ones,
-where underscores aren't trendy enough. Capitalization rules are
-sometimes part of the language, e.g. Haskell, which may thus encourage
-such a style. It is appropriate to add `capitalized-words-mode' to
-the mode hook for programming language modes in which you encounter
-variables like this, e.g. `java-mode-hook'. It's unlikely to cause
-trouble if such identifiers aren't used.
-
-See also `glasses-mode' and `studlify-word'.
-Obsoletes `c-forward-into-nomenclature'."
- nil " Caps" nil :group 'programming
- (set (make-local-variable 'find-word-boundary-function-table)
- capitalized-find-word-boundary-function-table))
-
-(provide 'cap-words)
-
-;;; cap-words.el ends here
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index f86e4b2c48a..6b406b0d89c 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2219,7 +2219,8 @@ comment at the start of cc-engine.el for more info."
((and (not not-in-delimiter) ; inside a comment starter
(not (bobp))
(progn (backward-char)
- (and (not (looking-at "\\s!"))
+ (and (not (and (memq 'category-properties c-emacs-features)
+ (looking-at "\\s!")))
(looking-at c-comment-start-regexp))))
(setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++)
co-st (point))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 30f30dfe83f..000d7191ee7 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -134,7 +134,7 @@ and a string describing how the process finished.")
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
- '((absoft
+ `((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -255,16 +255,46 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; can be composed of any non-newline char, but it also rules out some
;; valid but unlikely cases, such as a trailing space or a space
;; followed by a -, or a colon followed by a space.
-
+ ;;
;; The "in \\|from " exception was added to handle messages from Ruby.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
-\\([0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\
-\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\
-\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|\\[ skipping .+ \\]\\|\
-\\(?:instantiated\\|required\\) from\\|[Nn]ote\\)\\|\
- *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
+ ,(rx
+ bol
+ (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ (regexp "[ \t]+\\(?:in \\|from\\)")))
+ (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
+ (regexp ": ?")
+ (group-n 2 (regexp "[0-9]+"))
+ (? (| (: "-"
+ (group-n 4 (regexp "[0-9]+"))
+ (? "." (group-n 5 (regexp "[0-9]+"))))
+ (: (in ".:")
+ (group-n 3 (regexp "[0-9]+"))
+ (? "-"
+ (? (group-n 4 (regexp "[0-9]+")) ".")
+ (group-n 5 (regexp "[0-9]+"))))))
+ ":"
+ (| (: (* " ")
+ (group-n 6 (| "FutureWarning"
+ "RuntimeWarning"
+ "Warning"
+ "warning"
+ "W:")))
+ (: (* " ")
+ (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
+ "I:"
+ (: "[ skipping " (+ ".") " ]")
+ "instantiated from"
+ "required from"
+ (regexp "[Nn]ote"))))
+ (: (* " ")
+ (regexp "[Ee]rror"))
+ (: (regexp "[0-9]?")
+ (| (regexp "[^0-9\n]")
+ eol))
+ (regexp "[0-9][0-9][0-9]")))
1 (2 . 4) (3 . 5) (6 . 7))
(lcc
@@ -2039,8 +2069,7 @@ Optional argument MINOR indicates this is called from
(if minor
(progn
(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
(setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
(defun compilation--unsetup ()
@@ -2049,8 +2078,7 @@ Optional argument MINOR indicates this is called from
(remove-hook 'before-change-functions 'compilation--flush-parse t)
(kill-local-variable 'compilation--parsed)
(compilation--remove-properties)
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
;;;###autoload
(define-minor-mode compilation-shell-minor-mode
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 4e4fc138877..1aa5170591a 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -188,7 +188,7 @@ and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:group 'cwarn :lighter cwarn-mode-text
(cwarn-font-lock-keywords cwarn-mode)
- (if font-lock-mode (font-lock-fontify-buffer)))
+ (font-lock-flush))
;;;###autoload
(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 6aee713dd86..6431fa4aaf2 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -830,7 +830,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
(font-lock-mode 1)
(setq font-lock-keywords
(symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n))))
- (font-lock-fontify-buffer))
+ (font-lock-flush))
(defun f90-font-lock-1 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 99629450c1b..d60534074b9 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1,7 +1,6 @@
-;;; grep.el --- run `grep' and display the results
+;;; grep.el --- run `grep' and display the results -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -805,16 +804,20 @@ substitution string. Note dynamic scoping of variables.")
(defun grep-expand-template (template &optional regexp files dir excl)
"Patch grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>."
- (let ((command template)
- (cf case-fold-search)
- (case-fold-search nil))
+ (let* ((command template)
+ (env `((cf . ,case-fold-search)
+ (excl . ,excl)
+ (dir . ,dir)
+ (files . ,files)
+ (regexp . ,regexp)))
+ (case-fold-search nil))
(dolist (kw grep-expand-keywords command)
(if (string-match (car kw) command)
(setq command
(replace-match
(or (if (symbolp (cdr kw))
- (symbol-value (cdr kw))
- (save-match-data (eval (cdr kw))))
+ (eval (cdr kw) env)
+ (save-match-data (eval (cdr kw) env)))
"")
t t command))))))
@@ -901,7 +904,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(confirm (equal current-prefix-arg '(4))))
(list regexp files dir confirm))))))
(when (and (stringp regexp) (> (length regexp) 0))
- (unless (and dir (file-directory-p dir) (file-readable-p dir))
+ (unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
(let ((command regexp))
(if (null files)
@@ -982,7 +985,7 @@ to specify a command to run."
(confirm (equal current-prefix-arg '(4))))
(list regexp files dir confirm))))))
(when (and (stringp regexp) (> (length regexp) 0))
- (unless (and dir (file-directory-p dir) (file-readable-p dir))
+ (unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
(if (null files)
(if (not (string= regexp (if (consp grep-find-command)
@@ -1055,7 +1058,7 @@ to specify a command to run."
(setq default-directory dir)))))))
;;;###autoload
-(defun zrgrep (regexp &optional files dir confirm grep-find-template)
+(defun zrgrep (regexp &optional files dir confirm template)
"Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR.
Like `rgrep' but uses `zgrep' for `grep-program', sets the default
file name to `*.gz', and sets `grep-highlight-matches' to `always'."
@@ -1090,10 +1093,8 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'."
(list regexp files dir confirm grep-find-template)))))))
;; Set `grep-highlight-matches' to `always'
;; since `zgrep' puts filters in the grep output.
- (let ((grep-highlight-matches 'always))
- ;; `rgrep' uses the dynamically bound value `grep-find-template'
- ;; from the argument `grep-find-template' whose value is computed
- ;; in the `interactive' spec.
+ (let ((grep-find-template template)
+ (grep-highlight-matches 'always))
(rgrep regexp files dir confirm)))
;;;###autoload
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 39ad676f593..bcb46592465 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -407,6 +407,14 @@ that form should be displayed.")
(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
+(defun hif-string-to-number (string &optional base)
+ "Like `string-to-number', but it understands non-decimal floats."
+ (if (or (not base) (= base 10))
+ (string-to-number string base)
+ (let* ((parts (split-string string "\\." t "[ \t]+"))
+ (frac (cadr parts))
+ (quot (expt (* base 1.0) (length frac))))
+ (/ (string-to-number (concat (car parts) frac) base) quot))))
(defun hif-tokenize (start end)
"Separate string between START and END into a list of tokens."
@@ -433,15 +441,12 @@ that form should be displayed.")
;; TODO:
;; 1. postfix 'l', 'll', 'ul' and 'ull'
;; 2. floating number formats
- ;; 3. hexadecimal/octal floats
- ;; 4. 098 is interpreted as octal conversion error
- ;; FIXME: string-to-number does not convert hex floats
+ ;; 3. 098 is interpreted as octal conversion error
(if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)"
token)
- (string-to-number (match-string 1 token) 16)) ;; hex
- ;; FIXME: string-to-number does not convert octal floats
+ (hif-string-to-number (match-string 1 token) 16)) ;; hex
(if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
- (string-to-number token 8)) ;; octal
+ (hif-string-to-number token 8)) ;; octal
(if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
token)
(string-to-number token)) ;; decimal
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index e9349b655b0..45420f2a250 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -789,6 +789,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(unless hs-allow-nesting
(hs-discard-overlays (point-min) (point-max)))
(goto-char (point-min))
+ (syntax-propertize (point-max))
(let ((spew (make-progress-reporter "Hiding all blocks..."
(point-min) (point-max)))
(re (concat "\\("
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index e8a950c1fae..b9c41c9d699 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1177,15 +1177,13 @@ Useful when source code is displayed as help. See the option
(if (featurep 'font-lock)
(let ((major-mode 'idlwave-mode)
(font-lock-verbose
- (if (called-interactively-p 'interactive) font-lock-verbose nil))
- (syntax-table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table idlwave-mode-syntax-table)
- (set (make-local-variable 'font-lock-defaults)
- idlwave-font-lock-defaults)
- (font-lock-fontify-buffer))
- (set-syntax-table syntax-table)))))
+ (if (called-interactively-p 'interactive) font-lock-verbose nil)))
+ (with-syntax-table idlwave-mode-syntax-table
+ (set (make-local-variable 'font-lock-defaults)
+ idlwave-font-lock-defaults)
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (font-lock-fontify-buffer))))))
(defun idlwave-help-error (name type class keyword)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index ef372a34fdb..092aa2b2fac 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -66,22 +66,7 @@
;; a rich language; writing a more suitable parser would be a big job):
;; 2) The globbing syntax <pattern> is not recognized, so special
;; characters in the pattern string must be backslashed.
-;; 3) The << quoting operators are not recognized; see below.
-;; 5) To make '$' work correctly, $' is not recognized as a variable.
-;; Use "$'" or $POSTMATCH instead.
;;
-;; If you don't use font-lock, additional problems will appear:
-;; 1) Regular expression delimiters do not act as quotes, so special
-;; characters such as `'"#:;[](){} may need to be backslashed
-;; in regular expressions and in both parts of s/// and tr///.
-;; 4) The q and qq quoting operators are not recognized; see below.
-;; 5) To make variables such a $' and $#array work, perl-mode treats
-;; $ just like backslash, so '$' is not treated correctly.
-;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an
-;; unmatched }. See below.
-;; 7) When ' (quote) is used as a package name separator, perl-mode
-;; doesn't understand, and thinks it is seeing a quoted string.
-
;; Here are some ugly tricks to bypass some of these problems: the perl
;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
;; but will trick perl-mode into starting a quoted string, which
@@ -218,6 +203,13 @@
(defvar perl-quote-like-pairs
'((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
+(eval-and-compile
+ (defconst perl--syntax-exp-intro-regexp
+ (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
+ (regexp-opt '("split" "if" "unless" "until" "while" "print"
+ "grep" "map" "not" "or" "and" "for" "foreach"))
+ "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+
;; FIXME: handle here-docs and regexps.
;; <<EOF <<"EOF" <<'EOF' (no space)
;; see `man perlop'
@@ -278,10 +270,7 @@
;; *opening* slash. We can afford to mis-match the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
- ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
- (regexp-opt '("split" "if" "unless" "until" "while" "split"
- "grep" "map" "not" "or" "and" "for" "foreach"))
- "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
+ ((concat perl--syntax-exp-intro-regexp "\\(/\\)")
(2 (ignore
(if (and (match-end 1) ; / at BOL.
(save-excursion
@@ -316,10 +305,15 @@
(string-to-syntax "\"")))
(perl-syntax-propertize-special-constructs end)))))
;; Here documents.
- ;; TODO: Handle <<WORD. These are trickier because you need to
- ;; disambiguate with the shift operator.
- ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)"
- (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table))
+ ((concat
+ "\\(?:"
+ ;; << "EOF", << 'EOF', or << \EOF
+ "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
+ ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
+ ;; disambiguate with the left-bitshift operator.
+ "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)"
+ ".*\\(\n\\)")
+ (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table))
(name (match-string 1)))
(goto-char (match-end 1))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
@@ -329,7 +323,8 @@
;; Remember the names of heredocs found on this line.
(cons (pcase (aref name 0)
(`?\\ (substring name 1))
- (_ (substring name 1 -1)))
+ ((or `?\" `?\' `?\`) (substring name 1 -1))
+ (_ name))
(cdr st)))))))
;; We don't call perl-syntax-propertize-special-constructs directly
;; from the << rule, because there might be other elements (between
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 407466932d9..d0745d59955 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -116,7 +116,7 @@ support it."
(font-lock-add-keywords nil prettify-symbols--keywords)
(setq-local font-lock-extra-managed-props
(cons 'composition font-lock-extra-managed-props))
- (font-lock-fontify-buffer))
+ (font-lock-flush))
;; Turn off
(when prettify-symbols--keywords
(font-lock-remove-keywords nil prettify-symbols--keywords)
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index bcac59a3ade..a082d75b3c4 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -3340,8 +3340,6 @@ PREFIX is the prefix of the search regexp."
["Mark clause" prolog-mark-clause t]
["Mark predicate" prolog-mark-predicate t]
["Mark paragraph" mark-paragraph t]
- ;;"---"
- ;;["Fontify buffer" font-lock-fontify-buffer t]
))
(defun prolog-menu ()
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index f7de331f73b..7cf53cbe45c 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -41,6 +41,7 @@
(require 'comint)
(require 'easymenu)
+(require 'smie)
;; Define core `PostScript' group.
(defgroup PostScript nil
@@ -60,10 +61,7 @@
;; User variables.
-(defcustom ps-mode-auto-indent t
- "Should we use autoindent?"
- :group 'PostScript-edit
- :type 'boolean)
+(make-obsolete-variable 'ps-mode-auto-indent 'electric-indent-mode "24.5")
(defcustom ps-mode-tab 4
"Number of spaces to use when indenting."
@@ -204,7 +202,7 @@ If nil, use `temporary-file-directory'."
"bind" "null"
"gsave" "grestore" "grestoreall"
"showpage")))
- (concat "\\<" (regexp-opt ops t) "\\>"))
+ (concat "\\_<" (regexp-opt ops t) "\\_>"))
"Regexp of PostScript operators that will be fontified.")
;; Level 1 font-lock:
@@ -214,13 +212,9 @@ If nil, use `temporary-file-directory'."
;; - 8bit characters (warning face)
;; Multiline strings are not supported. Strings with nested brackets are.
(defconst ps-mode-font-lock-keywords-1
- '(("\\`%!PS.*" . font-lock-constant-face)
+ '(("\\`%!PS.*" (0 font-lock-constant-face t))
("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$"
- . font-lock-constant-face)
- (ps-mode-match-string-or-comment
- (1 font-lock-comment-face nil t)
- (2 font-lock-string-face nil t))
- ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face)
+ (0 font-lock-constant-face t))
("[\200-\377]+" (0 font-lock-warning-face prepend nil)))
"Subdued level highlighting for PostScript mode.")
@@ -255,19 +249,17 @@ If nil, use `temporary-file-directory'."
;; Names are fontified before PostScript operators, allowing the use of
;; a more simple (efficient) regexp than the one used in level 2.
(defconst ps-mode-font-lock-keywords-3
- (append
- ps-mode-font-lock-keywords-1
- (list
- '("//\\w+" . font-lock-type-face)
- `(,(concat
- "^\\(/\\w+\\)\\>"
- "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name.
- "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name.
- "\\|[ \t]+[0-9]+[ \t]+dict\\>" ; `[0-9]+ dict' following the name.
- "\\|.*\\<def\\>\\)") ; `def' somewhere on the same line.
- . (1 font-lock-function-name-face))
- '("/\\w+" . font-lock-variable-name-face)
- (cons ps-mode-operators 'font-lock-keyword-face)))
+ `(,@ps-mode-font-lock-keywords-1
+ ("//\\(?:\\sw\\|\\s_\\)+" . font-lock-type-face)
+ (,(concat
+ "^\\(/\\(?:\\sw\\|\\s_\\)+\\)\\_>"
+ "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name.
+ "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name.
+ "\\|[ \t]+[0-9]+[ \t]+dict\\_>" ; `[0-9]+ dict' following the name.
+ "\\|.*\\_<def\\_>\\)") ; `def' somewhere on the same line.
+ . (1 font-lock-function-name-face))
+ ("/\\(?:\\sw\\|\\s_\\)+" . font-lock-variable-name-face)
+ (,ps-mode-operators . font-lock-keyword-face))
"High level highlighting for PostScript mode.")
(defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1
@@ -289,13 +281,68 @@ If nil, use `temporary-file-directory'."
;; Variables.
-(defvar ps-mode-map nil
+(defvar ps-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-v" 'ps-run-boundingbox)
+ (define-key map "\C-c\C-u" 'ps-mode-uncomment-region)
+ (define-key map "\C-c\C-t" 'ps-mode-epsf-rich)
+ (define-key map "\C-c\C-s" 'ps-run-start)
+ (define-key map "\C-c\C-r" 'ps-run-region)
+ (define-key map "\C-c\C-q" 'ps-run-quit)
+ (define-key map "\C-c\C-p" 'ps-mode-print-buffer)
+ (define-key map "\C-c\C-o" 'ps-mode-comment-out-region)
+ (define-key map "\C-c\C-k" 'ps-run-kill)
+ (define-key map "\C-c\C-j" 'ps-mode-other-newline)
+ (define-key map "\C-c\C-l" 'ps-run-clear)
+ (define-key map "\C-c\C-b" 'ps-run-buffer)
+ ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
+ (define-key map "\177" 'ps-mode-backward-delete-char)
+ map)
"Local keymap to use in PostScript mode.")
-(defvar ps-mode-syntax-table nil
+(defvar ps-mode-syntax-table
+ (let ((st (make-syntax-table)))
+
+ (modify-syntax-entry ?\% "< " st)
+ (modify-syntax-entry ?\n "> " st)
+ (modify-syntax-entry ?\r "> " st)
+ (modify-syntax-entry ?\f "> " st)
+ (modify-syntax-entry ?\< "(>" st)
+ (modify-syntax-entry ?\> ")<" st)
+
+ (modify-syntax-entry ?\! "_ " st)
+ (modify-syntax-entry ?\" "_ " st)
+ (modify-syntax-entry ?\# "_ " st)
+ (modify-syntax-entry ?\$ "_ " st)
+ (modify-syntax-entry ?\& "_ " st)
+ (modify-syntax-entry ?\' "_ " st)
+ (modify-syntax-entry ?\* "_ " st)
+ (modify-syntax-entry ?\+ "_ " st)
+ (modify-syntax-entry ?\, "_ " st)
+ (modify-syntax-entry ?\- "_ " st)
+ (modify-syntax-entry ?\. "_ " st)
+ (modify-syntax-entry ?\: "_ " st)
+ (modify-syntax-entry ?\; "_ " st)
+ (modify-syntax-entry ?\= "_ " st)
+ (modify-syntax-entry ?\? "_ " st)
+ (modify-syntax-entry ?\@ "_ " st)
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?^ "_ " st) ; NOT: ?\^
+ (modify-syntax-entry ?\_ "_ " st)
+ (modify-syntax-entry ?\` "_ " st)
+ (modify-syntax-entry ?\| "_ " st)
+ (modify-syntax-entry ?\~ "_ " st)
+ st)
"Syntax table used while in PostScript mode.")
-(defvar ps-run-mode-map nil
+(defvar ps-run-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map comint-mode-map)
+ (define-key map "\C-c\C-q" 'ps-run-quit)
+ (define-key map "\C-c\C-k" 'ps-run-kill)
+ (define-key map "\C-c\C-e" 'ps-run-goto-error)
+ (define-key map [mouse-2] 'ps-run-mouse-goto-error)
+ map)
"Local keymap to use in PostScript run mode.")
(defvar ps-mode-tmp-file nil
@@ -365,9 +412,6 @@ If nil, use `temporary-file-directory'."
["8-bit to Octal Buffer" ps-mode-octal-buffer t]
["8-bit to Octal Region" ps-mode-octal-region (mark t)]
"---"
- ["Auto Indent" (setq ps-mode-auto-indent (not ps-mode-auto-indent))
- :style toggle :selected ps-mode-auto-indent]
- "---"
["Start PostScript"
ps-run-start
t]
@@ -404,79 +448,7 @@ If nil, use `temporary-file-directory'."
ps-mode-submit-bug-report
t]))
-
-;; Mode maps for PostScript edit mode and PostScript interaction mode.
-
-(unless ps-mode-map
- (setq ps-mode-map (make-sparse-keymap))
- (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox)
- (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region)
- (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich)
- (define-key ps-mode-map "\C-c\C-s" 'ps-run-start)
- (define-key ps-mode-map "\C-c\C-r" 'ps-run-region)
- (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit)
- (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer)
- (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region)
- (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill)
- (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline)
- (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear)
- (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer)
- (define-key ps-mode-map ">" 'ps-mode-r-gt)
- (define-key ps-mode-map "]" 'ps-mode-r-angle)
- (define-key ps-mode-map "}" 'ps-mode-r-brace)
- (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char)
- (define-key ps-mode-map "\t" 'ps-mode-tabkey)
- (define-key ps-mode-map "\r" 'ps-mode-newline)
- (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main))
-
-(unless ps-run-mode-map
- (setq ps-run-mode-map (make-sparse-keymap))
- (set-keymap-parent ps-run-mode-map comint-mode-map)
- (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit)
- (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill)
- (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error)
- (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error))
-
-
-;; Syntax table.
-
-(unless ps-mode-syntax-table
- (setq ps-mode-syntax-table (make-syntax-table))
-
- (modify-syntax-entry ?\% "< " ps-mode-syntax-table)
- (modify-syntax-entry ?\n "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\r "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\f "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\< "(>" ps-mode-syntax-table)
- (modify-syntax-entry ?\> ")<" ps-mode-syntax-table)
-
- (modify-syntax-entry ?\! "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\" "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\# "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\$ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\& "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\' "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\* "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\+ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\, "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\- "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\. "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\: "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\; "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\= "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\? "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\@ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\\ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^
- (modify-syntax-entry ?\_ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\` "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\| "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\~ "w " ps-mode-syntax-table)
-
- (let ((i 128))
- (while (< i 256)
- (modify-syntax-entry i "w " ps-mode-syntax-table)
- (setq i (1+ i)))))
+(easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)
@@ -484,6 +456,13 @@ If nil, use `temporary-file-directory'."
;; PostScript mode.
+(defun ps-mode-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:after . "<") (when (smie-rule-next-p "<") 0))
+ (`(:elem . basic) ps-mode-tab)
+ (`(:close-all . ">") t)
+ (`(:list-intro . ,_) t)))
+
;;;###autoload
(define-derived-mode ps-mode prog-mode "PostScript"
"Major mode for editing PostScript with GNU Emacs.
@@ -493,7 +472,6 @@ Entry to this mode calls `ps-mode-hook'.
The following variables hold user options, and can
be set through the `customize' command:
- `ps-mode-auto-indent'
`ps-mode-tab'
`ps-mode-paper-size'
`ps-mode-print-function'
@@ -523,12 +501,16 @@ with a file position. Clicking mouse-2 on this number will bring
point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect."
+ (setq-local syntax-propertize-function #'ps-mode-syntax-propertize)
(set (make-local-variable 'font-lock-defaults)
'((ps-mode-font-lock-keywords
ps-mode-font-lock-keywords-1
ps-mode-font-lock-keywords-2
ps-mode-font-lock-keywords-3)
- t))
+ nil))
+ (smie-setup nil #'ps-mode-smie-rules)
+ (setq-local electric-indent-chars
+ (append '(?> ?\] ?\}) electric-indent-chars))
(set (make-local-variable 'comment-start) "%")
;; NOTE: `\' has a special meaning in strings only
(set (make-local-variable 'comment-start-skip) "%+[ \t]*")
@@ -555,8 +537,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
(reporter-submit-bug-report
ps-mode-maintainer-address
(format "ps-mode.el %s [%s]" ps-mode-version system-type)
- '(ps-mode-auto-indent
- ps-mode-tab
+ '(ps-mode-tab
ps-mode-paper-size
ps-mode-print-function
ps-run-prompt
@@ -570,53 +551,54 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
;; Helper functions for font-lock.
-;; When this function is called, point is at an opening bracket.
-;; This function should test if point is at the start of a string
-;; with nested brackets.
-;; If true: move point to end of string
-;; set string to match data nr 2
-;; return new point
-;; If false: return nil
-(defun ps-mode-looking-at-nested (limit)
- (let ((first (point))
- (level 1)
- pos)
- ;; Move past opening bracket.
- (forward-char 1)
- (setq pos (point))
- (while (and (> level 0) (< pos limit))
- ;; Search next bracket, stepping over escaped brackets.
- (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)"))
- (setq level -1)
- (setq level (+ level (if (string= "(" (match-string 2)) 1 -1)))
- (goto-char (setq pos (match-end 0)))))
- (if (not (= level 0))
- nil
- ;; Found string with nested brackets, now set match data nr 2.
- (set-match-data (list first pos nil nil first pos))
- pos)))
-
-;; This function should search for a string or comment
-;; If comment, return as match data nr 1
-;; If string, return as match data nr 2
-(defun ps-mode-match-string-or-comment (limit)
- ;; Find the first potential match.
- (if (not (re-search-forward "[%(]" limit t))
- ;; Nothing found: return failure.
- nil
- (let ((end (match-end 0)))
- (goto-char (match-beginning 0))
- (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)")
- ;; It's a comment or string without nested, unescaped brackets.
- (goto-char (match-end 0))
- (point))
- ((ps-mode-looking-at-nested limit)
- ;; It's a string with nested brackets.
- (point))
- (t
- ;; Try next match.
- (goto-char end)
- (ps-mode-match-string-or-comment limit))))))
+(defconst ps-mode--string-syntax-table
+ (let ((st (make-syntax-table ps-mode-syntax-table)))
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?\{ "." st)
+ (modify-syntax-entry ?\} "." st)
+ (modify-syntax-entry ?\[ "." st)
+ (modify-syntax-entry ?\] "." st)
+ st))
+
+(defun ps-mode--syntax-propertize-special (end)
+ (let ((ppss (syntax-ppss))
+ char)
+ (cond
+ ((not (nth 3 ppss))) ;Not in (...), <~..base85..~>, or <..hex..>.
+ ((eq ?\( (setq char (char-after (nth 8 ppss))))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (goto-char (nth 8 ppss))
+ (condition-case nil
+ (with-syntax-table ps-mode--string-syntax-table
+ (let ((parse-sexp-lookup-properties nil))
+ (forward-sexp 1))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "|")))
+ (scan-error (goto-char end)))))
+ ((eq char ?<)
+ (when (re-search-forward (if (eq ?~ (char-after (1+ (nth 8 ppss))))
+ "~>" ">")
+ end 'move)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "|")))))))
+
+(defun ps-mode-syntax-propertize (start end)
+ (goto-char start)
+ (ps-mode--syntax-propertize-special end)
+ (funcall
+ (syntax-propertize-rules
+ ("\\(<\\)\\(?:~\\|[ \n\t]*[[:xdigit:]]\\)\\|\\(?1:(\\)"
+ (1 (unless (or (eq (char-after (match-beginning 0))
+ (char-before (match-beginning 0))) ;Avoid "<<".
+ (nth 8 (save-excursion (syntax-ppss (match-beginning 1)))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "|"))
+ (ps-mode--syntax-propertize-special end)
+ nil))))
+ (point) end))
;; Key-handlers.
@@ -654,34 +636,12 @@ defines the beginning of a group. These tokens are: { [ <<"
(setq target (+ target ps-mode-tab)))
target)))))
-(defun ps-mode-newline ()
- "Insert newline with proper indentation."
- (interactive)
- (delete-horizontal-space)
- (insert "\n")
- (if ps-mode-auto-indent
- (indent-to (ps-mode-target-column))))
-
-(defun ps-mode-tabkey ()
- "Indent/reindent current line, or insert tab."
- (interactive)
- (let ((column (current-column))
- target)
- (if (or (not ps-mode-auto-indent)
- (< ps-mode-tab 1)
- (not (re-search-backward "^[ \t]*\\=" nil t)))
- (insert "\t")
- (setq target (ps-mode-target-column))
- (while (<= target column)
- (setq target (+ target ps-mode-tab)))
- (indent-line-to target))))
-
(defun ps-mode-backward-delete-char ()
"Delete backward indentation, or delete backward character."
(interactive)
(let ((column (current-column))
target)
- (if (or (not ps-mode-auto-indent)
+ (if (or (not electric-indent-mode)
(< ps-mode-tab 1)
(not (re-search-backward "^[ \t]+\\=" nil t)))
(call-interactively 'delete-backward-char)
@@ -694,32 +654,6 @@ defines the beginning of a group. These tokens are: { [ <<"
(setq target 0))
(indent-line-to target))))
-(defun ps-mode-r-brace ()
- "Insert `}' and perform balance."
- (interactive)
- (insert "}")
- (ps-mode-r-balance "}"))
-
-(defun ps-mode-r-angle ()
- "Insert `]' and perform balance."
- (interactive)
- (insert "]")
- (ps-mode-r-balance "]"))
-
-(defun ps-mode-r-gt ()
- "Insert `>' and perform balance."
- (interactive)
- (insert ">")
- (ps-mode-r-balance ">>"))
-
-(defun ps-mode-r-balance (right)
- "Adjust indenting if point after RIGHT."
- (if ps-mode-auto-indent
- (save-excursion
- (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t)
- (indent-line-to (ps-mode-target-column)))))
- (blink-matching-open))
-
(defun ps-mode-other-newline ()
"Perform newline in `*ps-run*' buffer."
(interactive)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 240cf8aff8c..91a85526420 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -155,15 +155,13 @@
;; the shell completion in background so you should run
;; `python-shell-send-buffer' from time to time to get better results.
-;; Skeletons: 6 skeletons are provided for simple inserting of class,
-;; def, for, if, try and while. These skeletons are integrated with
-;; abbrev. If you have `abbrev-mode' activated and
+;; Skeletons: skeletons are provided for simple inserting of things like class,
+;; def, for, import, if, try, and while. These skeletons are
+;; integrated with abbrev. If you have `abbrev-mode' activated and
;; `python-skeleton-autoinsert' is set to t, then whenever you type
;; the name of any of those defined and hit SPC, they will be
;; automatically expanded. As an alternative you can use the defined
-;; skeleton commands: `python-skeleton-class', `python-skeleton-def'
-;; `python-skeleton-for', `python-skeleton-if', `python-skeleton-try'
-;; and `python-skeleton-while'.
+;; skeleton commands: `python-skeleton-<foo>'.
;; FFAP: You can find the filename for a given module when using ffap
;; out of the box. This feature needs an inferior python shell
@@ -253,6 +251,7 @@
(define-key map "\C-c\C-td" 'python-skeleton-def)
(define-key map "\C-c\C-tf" 'python-skeleton-for)
(define-key map "\C-c\C-ti" 'python-skeleton-if)
+ (define-key map "\C-c\C-tm" 'python-skeleton-import)
(define-key map "\C-c\C-tt" 'python-skeleton-try)
(define-key map "\C-c\C-tw" 'python-skeleton-while)
;; Shell interaction
@@ -2005,7 +2004,7 @@ process buffer for a list of commands.)"
(interactive
(if current-prefix-arg
(list
- (read-string "Run Python: " (python-shell-parse-command))
+ (read-shell-command "Run Python: " (python-shell-parse-command))
(y-or-n-p "Make dedicated process? ")
(= (prefix-numeric-value current-prefix-arg) 4))
(list (python-shell-parse-command) nil t)))
@@ -2058,8 +2057,7 @@ startup."
(global-proc-name (python-shell-get-process-name nil))
(global-proc-buffer-name (format "*%s*" global-proc-name))
(dedicated-running (comint-check-proc dedicated-proc-buffer-name))
- (global-running (comint-check-proc global-proc-buffer-name))
- (current-prefix-arg 16))
+ (global-running (comint-check-proc global-proc-buffer-name)))
(when (and (not dedicated-running) (not global-running))
(if (call-interactively 'run-python)
(setq dedicated-running t)
@@ -2958,6 +2956,12 @@ The skeleton will be bound to python-skeleton-NAME."
> _ \n
'(python-skeleton--else) | ^)
+(python-skeleton-define import nil
+ "Import from module: "
+ "from " str & " " | -5
+ "import "
+ ("Identifier: " str ", ") -2 \n _)
+
(python-skeleton-define try nil
nil
"try:" \n
@@ -2984,7 +2988,7 @@ The skeleton will be bound to python-skeleton-NAME."
"class " str "(" ("Inheritance, %s: "
(unless (equal ?\( (char-before)) ", ")
str)
- & ")" | -2
+ & ")" | -1
":" \n
"\"\"\"" - "\"\"\"" \n
> _ \n)
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 5ad5633fa85..c47a3bd6fbe 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -1,4 +1,4 @@
-;;; scheme.el --- Scheme (and DSSSL) editing mode
+;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*-
;; Copyright (C) 1986-1988, 1997-1998, 2001-2014 Free Software
;; Foundation, Inc.
@@ -280,7 +280,9 @@ See `run-hooks'."
"\\|-module"
"\\)\\)\\>"
;; Any whitespace and declared object.
- "[ \t]*(?"
+ ;; The "(*" is for curried definitions, e.g.,
+ ;; (define ((sum a) b) (+ a b))
+ "[ \t]*(*"
"\\(\\sw+\\)?")
'(1 font-lock-keyword-face)
'(6 (cond ((match-beginning 3) font-lock-function-name-face)
@@ -491,20 +493,20 @@ indentation."
;;; Let is different in Scheme
-(defun would-be-symbol (string)
- (not (string-equal (substring string 0 1) "(")))
+;; (defun scheme-would-be-symbol (string)
+;; (not (string-equal (substring string 0 1) "(")))
-(defun next-sexp-as-string ()
- ;; Assumes that it is protected by a save-excursion
- (forward-sexp 1)
- (let ((the-end (point)))
- (backward-sexp 1)
- (buffer-substring (point) the-end)))
+;; (defun scheme-next-sexp-as-string ()
+;; ;; Assumes that it is protected by a save-excursion
+;; (forward-sexp 1)
+;; (let ((the-end (point)))
+;; (backward-sexp 1)
+;; (buffer-substring (point) the-end)))
;; This is correct but too slow.
;; The one below works almost always.
;;(defun scheme-let-indent (state indent-point)
-;; (if (would-be-symbol (next-sexp-as-string))
+;; (if (scheme-would-be-symbol (scheme-next-sexp-as-string))
;; (scheme-indent-specform 2 state indent-point)
;; (scheme-indent-specform 1 state indent-point)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 03c845851e2..b4148ef5621 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -237,6 +237,7 @@
(ksh88 . jsh)
(oash . sh)
(pdksh . ksh88)
+ (mksh . pdksh)
(posix . sh)
(tcsh . csh)
(wksh . ksh88)
@@ -262,6 +263,7 @@ sh Bourne Shell
ksh Korn Shell '93
dtksh CDE Desktop Korn Shell
pdksh Public Domain Korn Shell
+ mksh MirOS BSD Korn Shell
wksh Window Korn Shell
zsh Z Shell
oash SCO OA (curses) Shell
@@ -271,7 +273,6 @@ sh Bourne Shell
:version "24.4" ; added dash
:group 'sh-script)
-
(defcustom sh-alias-alist
(append (if (eq system-type 'gnu/linux)
'((csh . tcsh)
@@ -279,11 +280,20 @@ sh Bourne Shell
;; for the time being
'((ksh . ksh88)
(bash2 . bash)
- (sh5 . sh)))
+ (sh5 . sh)
+ ;; Android's system shell
+ ("^/system/bin/sh$" . mksh)))
"Alist for transforming shell names to what they really are.
-Use this where the name of the executable doesn't correspond to the type of
-shell it really is."
- :type '(repeat (cons symbol symbol))
+Use this where the name of the executable doesn't correspond to
+the type of shell it really is. Keys are regular expressions
+matched against the full path of the interpreter. (For backward
+compatibility, keys may also be symbols, which are matched
+against the interpreter's basename. The values are symbols
+naming the shell."
+ :type '(repeat (cons (radio
+ (regexp :tag "Regular expression")
+ (symbol :tag "Basename"))
+ (symbol :tag "Shell")))
:group 'sh-script)
@@ -387,15 +397,20 @@ the car and cdr are the same symbol.")
"Non-nil if `sh-shell-variables' is initialized.")
(defun sh-canonicalize-shell (shell)
- "Convert a shell name SHELL to the one we should handle it as."
- (if (string-match "\\.exe\\'" shell)
- (setq shell (substring shell 0 (match-beginning 0))))
- (or (symbolp shell)
- (setq shell (intern shell)))
- (or (cdr (assq shell sh-alias-alist))
- shell))
-
-(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
+ "Convert a shell name SHELL to the one we should handle it as.
+SHELL is a full path to the shell interpreter; return a shell
+name symbol."
+ (cl-loop
+ with shell = (cond ((string-match "\\.exe\\'" shell)
+ (substring shell 0 (match-beginning 0)))
+ (t shell))
+ with shell-base = (intern (file-name-nondirectory shell))
+ for (key . value) in sh-alias-alist
+ if (and (stringp key) (string-match key shell)) return value
+ if (eq key shell-base) return value
+ finally return shell-base))
+
+(defvar sh-shell (sh-canonicalize-shell sh-shell-file)
"The shell being programmed. This is set by \\[sh-set-shell].")
;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp)
@@ -677,7 +692,7 @@ removed when closing the here document."
"jobs" "kill" "let" "local" "popd" "printf" "pushd" "shopt"
"source" "suspend" "typeset" "unalias"
;; bash4
- "mapfile" "readarray")
+ "mapfile" "readarray" "coproc")
;; The next entry is only used for defining the others
(bourne sh-append shell
@@ -1533,6 +1548,12 @@ When the region is active, send the region instead."
;; mode-command and utility functions
+(defun sh-after-hack-local-variables ()
+ (when (assq 'sh-shell file-local-variables-alist)
+ (sh-set-shell (if (symbolp sh-shell)
+ (symbol-name sh-shell)
+ sh-shell))))
+
;;;###autoload
(define-derived-mode sh-mode prog-mode "Shell-script"
"Major mode for editing shell scripts.
@@ -1643,7 +1664,9 @@ with your script for an edit-interpret-debug cycle."
((string-match "[.]csh\\>" buffer-file-name) "csh")
((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
(t sh-shell-file))
- nil nil))
+ nil nil)
+ (add-hook 'hack-local-variables-hook
+ #'sh-after-hack-local-variables nil t))
;;;###autoload
(defalias 'shell-script-mode 'sh-mode)
@@ -2253,9 +2276,7 @@ Calls the value of `sh-set-shell-hook' if set."
t))
(if (string-match "\\.exe\\'" shell)
(setq shell (substring shell 0 (match-beginning 0))))
- (setq sh-shell (intern (file-name-nondirectory shell))
- sh-shell (or (cdr (assq sh-shell sh-alias-alist))
- sh-shell))
+ (setq sh-shell (sh-canonicalize-shell shell))
(if insert-flag
(setq sh-shell-file
(executable-set-magic shell (sh-feature sh-shell-arg)
@@ -2302,7 +2323,7 @@ Calls the value of `sh-set-shell-hook' if set."
(when font-lock-mode
(setq font-lock-set-defaults nil)
(font-lock-set-defaults)
- (font-lock-fontify-buffer))
+ (font-lock-flush))
(setq sh-shell-process nil)
(run-hooks 'sh-set-shell-hook))
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index f9efa3732c7..a8455c50064 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -1,4 +1,4 @@
-;;; subword.el --- Handling capitalized subwords in a nomenclature
+;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
@@ -21,13 +21,10 @@
;;; Commentary:
-;; This package was cc-submode.el before it was recognized being
-;; useful in general and not tied to C and c-mode at all.
-
-;; This package provides `subword' oriented commands and a minor mode
-;; (`subword-mode') that substitutes the common word handling
-;; functions with them. It also provides the `superword-mode' minor
-;; mode that treats symbols as words, the opposite of `subword-mode'.
+;; This package provides the `subword' minor mode, which merges the
+;; old remap-based subword.el (derived from cc-mode code) and
+;; cap-words.el, which takes advantage of core Emacs
+;; word-motion-customization functionality.
;; In spite of GNU Coding Standards, it is popular to name a symbol by
;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
@@ -47,25 +44,6 @@
;; words. You also get a mode to treat symbols as words instead,
;; called `superword-mode' (the opposite of `subword-mode').
-;; In the minor mode, all common key bindings for word oriented
-;; commands are overridden by the subword oriented commands:
-
-;; Key Word oriented command Subword oriented command (also superword)
-;; ============================================================
-;; M-f `forward-word' `subword-forward'
-;; M-b `backward-word' `subword-backward'
-;; M-@ `mark-word' `subword-mark'
-;; M-d `kill-word' `subword-kill'
-;; M-DEL `backward-kill-word' `subword-backward-kill'
-;; M-t `transpose-words' `subword-transpose'
-;; M-c `capitalize-word' `subword-capitalize'
-;; M-u `upcase-word' `subword-upcase'
-;; M-l `downcase-word' `subword-downcase'
-;;
-;; Note: If you have changed the key bindings for the word oriented
-;; commands in your .emacs or a similar place, the keys you've changed
-;; to are also used for the corresponding subword oriented commands.
-
;; To make the mode turn on automatically, put the following code in
;; your .emacs:
;;
@@ -102,27 +80,25 @@
"Regexp used by `subword-backward-internal'.")
(defvar subword-mode-map
- (let ((map (make-sparse-keymap)))
- (dolist (cmd '(forward-word backward-word mark-word kill-word
- backward-kill-word transpose-words
- capitalize-word upcase-word downcase-word
- left-word right-word))
- (let ((othercmd (let ((name (symbol-name cmd)))
- (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
- (intern (concat "subword-" (match-string 1 name))))))
- (define-key map (vector 'remap cmd) othercmd)))
- map)
+ ;; We originally remapped motion keys here, but now use Emacs core
+ ;; hooks. Leave this keymap around so that user additions to it
+ ;; keep working.
+ (make-sparse-keymap)
"Keymap used in `subword-mode' minor mode.")
;;;###autoload
+(define-obsolete-function-alias
+ 'capitalized-words-mode 'subword-mode "24.5")
+
+;;;###autoload
(define-minor-mode subword-mode
"Toggle subword movement and editing (Subword mode).
With a prefix argument ARG, enable Subword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Subword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to subword-based commands that handle
+Subword mode is a buffer-local minor mode. Enabling it changes
+the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
@@ -136,13 +112,13 @@ called a `subword'. Here are some examples:
EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
-The subword oriented commands activated in this minor mode recognize
-subwords in a nomenclature to move between subwords and to edit them
-as words.
+This mode changes the definition of a word so that word commands
+treat nomenclature boundaries as word bounaries.
\\{subword-mode-map}"
:lighter " ,"
- (when subword-mode (superword-mode -1)))
+ (when subword-mode (superword-mode -1))
+ (subword-setup-buffer))
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
@@ -151,6 +127,13 @@ as words.
(lambda () (subword-mode 1))
:group 'convenience)
+;; N.B. These commands aren't used unless explicitly invoked; they're
+;; here for compatibility. Today, subword-mode leaves motion commands
+;; alone and uses `find-word-boundary-function-table' to change how
+;; `forward-word' and other low-level commands detect word bounaries.
+;; This way, all word-related activities, not just the images we
+;; imagine here, get subword treatment.
+
(defun subword-forward (&optional arg)
"Do the same as `forward-word' but on subwords.
See the command `subword-mode' for a description of subwords.
@@ -159,10 +142,10 @@ Optional argument ARG is the same as for `forward-word'."
(unless arg (setq arg 1))
(cond
((< 0 arg)
- (dotimes (i arg (point))
+ (dotimes (_i arg (point))
(funcall subword-forward-function)))
((> 0 arg)
- (dotimes (i (- arg) (point))
+ (dotimes (_i (- arg) (point))
(funcall subword-backward-function)))
(t
(point))))
@@ -262,7 +245,7 @@ Optional argument ARG is the same as for `capitalize-word'."
(start (point))
(advance (>= arg 0)))
- (dotimes (i count)
+ (dotimes (_i count)
(if advance
(progn
(re-search-forward "[[:alpha:]]")
@@ -290,17 +273,15 @@ With a prefix argument ARG, enable Superword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Superword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to superword-based commands that
-treat symbols as words, e.g. \"this_is_a_symbol\".
-
-The superword oriented commands activated in this minor mode
-recognize symbols as superwords to move between superwords and to
-edit them as words.
+Superword mode is a buffer-local minor mode. Enabling it changes
+the definition of words such that symbols characters are treated
+as parts of words: e.g., in `superword-mode',
+\"this_is_a_symbol\" counts as one word.
\\{superword-mode-map}"
:lighter " ²"
- (when superword-mode (subword-mode -1)))
+ (when superword-mode (subword-mode -1))
+ (subword-setup-buffer))
;;;###autoload
(define-global-minor-mode global-superword-mode superword-mode
@@ -347,9 +328,45 @@ edit them as words.
(1+ (match-beginning 0)))))
(backward-word 1))))
+(defconst subword-find-word-boundary-function-table
+ (let ((tab (make-char-table nil)))
+ (set-char-table-range tab t #'subword-find-word-boundary)
+ tab)
+ "Assigned to `find-word-boundary-function-table' in
+`subword-mode' and `superword-mode'; defers to
+`subword-find-word-bounary'.")
+
+(defconst subword-empty-char-table
+ (make-char-table nil)
+ "Assigned to `find-word-boundary-function-table' while we're
+searching subwords in order to avoid unwanted reentrancy.")
+
+(defun subword-setup-buffer ()
+ (set (make-local-variable 'find-word-boundary-function-table)
+ (if (or subword-mode superword-mode)
+ subword-find-word-boundary-function-table
+ subword-empty-char-table)))
+
+(defun subword-find-word-boundary (pos limit)
+ "Catch-all handler in `subword-find-word-boundary-function-table'."
+ (let ((find-word-boundary-function-table subword-empty-char-table))
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (if (< pos limit)
+ (progn
+ (goto-char pos)
+ (narrow-to-region (point-min) limit)
+ (funcall subword-forward-function))
+ (goto-char (1+ pos))
+ (narrow-to-region limit (point-max))
+ (funcall subword-backward-function))
+ (point))))))
+
(provide 'subword)
(provide 'superword)
+(provide 'cap-words) ; Obsolete alias
;;; subword.el ends here
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 069e7119b90..7cb8f457e3f 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -138,7 +138,6 @@ If nil, TAB always indents current line."
(define-key map "\C-c\t" 'indent-according-to-mode)
(define-key map "\M-\C-\\" 'vera-indent-region)
(define-key map "\C-c\C-c" 'vera-comment-uncomment-region)
- (define-key map "\C-c\C-f" 'vera-fontify-buffer)
(define-key map "\C-c\C-v" 'vera-version)
(define-key map "\M-\t" 'tab-to-tab-stop)
;; Electric key bindings.
@@ -172,8 +171,6 @@ If nil, TAB always indents current line."
["Indent Region" vera-indent-region (mark)]
["Indent Buffer" vera-indent-buffer t]
"--"
- ["Fontify Buffer" vera-fontify-buffer t]
- "--"
["Documentation" describe-mode]
["Version" vera-version t]
["Bug Report..." vera-submit-bug-report t]
@@ -686,7 +683,8 @@ Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'."
"Font lock mode face used to highlight interface names."
:group 'font-lock-highlighting-faces)
-(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer)
+(define-obsolete-function-alias 'vera-fontify-buffer
+ 'font-lock-fontify-buffer "24.5")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indentation
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 84d7c15f76c..b649959bae3 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -123,7 +123,7 @@
;;; Code:
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2013-11-05-78e66ba-vpo"
+(defconst verilog-mode-version "2014-05-31-3cd8144-vpo"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -1020,6 +1020,20 @@ SystemVerilog designs."
:type 'string)
(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
+(defcustom verilog-auto-arg-format 'packed
+ "Formatting to use for AUTOARG signal names.
+If 'packed', then as many inputs and outputs that fit within
+`fill-column' will be put onto one line.
+
+If 'single', then a single input or output will be put onto each
+line."
+ :version "24.5"
+ :type '(radio (const :tag "Line up Assignments and Declarations" packed)
+ (const :tag "Line up Assignment statements" single))
+ :group 'verilog-mode-auto)
+(put 'verilog-auto-arg-format 'safe-local-variable
+ '(lambda (x) (memq x '(packed single))))
+
(defcustom verilog-auto-arg-sort nil
"Non-nil means AUTOARG signal names will be sorted, not in declaration order.
Declaration order is advantageous with order based instantiations
@@ -1634,7 +1648,7 @@ will break, as the o's continuously replace. xa -> x works ok though."
string))
(defsubst verilog-re-search-forward (REGEXP BOUND NOERROR)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `re-search-forward', but skips over match in comments or strings."
(let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found
(while (and
@@ -1650,7 +1664,7 @@ will break, as the o's continuously replace. xa -> x works ok though."
(match-end 0)))
(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `re-search-backward', but skips over match in comments or strings."
(let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found
(while (and
@@ -1679,7 +1693,7 @@ so there may be a large up front penalty for the first search."
pt))
(defsubst verilog-re-search-backward-quick (regexp bound noerror)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR,
but trashes match data and is faster for REGEXP that doesn't match often.
This uses `verilog-scan' and text properties to ignore comments,
@@ -1748,6 +1762,7 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
(unless (bolp) (insert "\n"))))
(defvar compile-command)
+(defvar create-lockfiles) ;; Emacs 24
;; compilation program
(defun verilog-set-compile-command ()
@@ -2788,8 +2803,8 @@ find the errors."
"sync_reject_on" "unique0" "until" "until_with" "untyped" "weak"
;; 1800-2012
"implements" "interconnect" "nettype" "soft"
- )
- "List of Verilog keywords.")
+ )
+ "List of Verilog keywords.")
(defconst verilog-comment-start-regexp "//\\|/\\*"
"Dual comment value for `comment-start-regexp'.")
@@ -2906,7 +2921,7 @@ See also `verilog-font-lock-extra-types'.")
'(
"and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam"
"event" "genvar" "inout" "input" "integer" "localparam"
- "logic" "mailbox" "nand" "nmos" "not" "notif0" "notif1" "or"
+ "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" "notif1" "or"
"output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup"
"rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran"
"rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply"
@@ -3332,9 +3347,9 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-backward reg nil 'move))
(cond
((match-end 1) ; matched verilog-end-block-re
- ; try to leap back to matching outward block by striding across
- ; indent level changing tokens then immediately
- ; previous line governs indentation.
+ ;; try to leap back to matching outward block by striding across
+ ;; indent level changing tokens then immediately
+ ;; previous line governs indentation.
(verilog-leap-to-head))
((match-end 2) ; else, we're in deep
(setq elsec (1+ elsec)))
@@ -3992,7 +4007,7 @@ This puts the mark at the end, and point at the beginning."
(mark-defun)))
(defun verilog-comment-region (start end)
- ; checkdoc-params: (start end)
+ ;; checkdoc-params: (start end)
"Put the region into a Verilog comment.
The comments that are in this area are \"deformed\":
`*)' becomes `!(*' and `}' becomes `!{'.
@@ -4223,7 +4238,7 @@ Uses `verilog-scan' cache."
((equal (char-after) ?\})
(forward-char))
- ;; Skip to end of statement
+ ;; Skip to end of statement
((condition-case nil
(setq pos
(catch 'found
@@ -4285,7 +4300,7 @@ More specifically, point @ in the line foo : @ begin"
(setq nest (1+ nest)))
((match-end 2)
(if (= nest 1)
- (throw 'found 1))
+ (throw 'found 1))
(setq nest (1- nest)))
(t
(throw 'found (= nest 0)))))))
@@ -4430,6 +4445,7 @@ Limit search to point LIM."
"\\(`ifdef\\>\\)\\|"
"\\(`ifndef\\>\\)\\|"
"\\(`elsif\\>\\)"))
+
(defun verilog-set-auto-endcomments (indent-str kill-existing-comment)
"Add ending comment with given INDENT-STR.
With KILL-EXISTING-COMMENT, remove what was there before.
@@ -5078,13 +5094,13 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`."
(list
(let ((default (verilog-expand-command verilog-preprocessor)))
(set (make-local-variable `verilog-preprocessor)
- (read-from-minibuffer "Run Preprocessor (like this): "
- default nil nil
- 'verilog-preprocess-history default)))))
+ (read-from-minibuffer "Run Preprocessor (like this): "
+ default nil nil
+ 'verilog-preprocess-history default)))))
(unless command (setq command (verilog-expand-command verilog-preprocessor)))
(let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode))
- (dir (file-name-directory (or filename buffer-file-name)))
- (cmd (concat "cd " dir "; " command)))
+ (dir (file-name-directory (or filename buffer-file-name)))
+ (cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
(with-current-buffer (get-buffer "*Verilog-Preprocessed*")
(insert (concat "// " cmd "\n"))
@@ -5092,7 +5108,11 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`."
(verilog-mode)
;; Without this force, it takes a few idle seconds
;; to get the color, which is very jarring
- (when fontlocked (font-lock-fontify-buffer))))))
+ (unless (fboundp 'font-lock-ensure)
+ ;; We should use font-lock-ensure in preference to
+ ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
+ ;; solve only appears in Emacsen older than font-lock-ensure anyway.
+ (when fontlocked (font-lock-fontify-buffer)))))))
;;
@@ -5138,23 +5158,29 @@ Save the result unless optional NO-SAVE is t."
;; Make sure any sub-files we read get proper mode
(setq-default major-mode 'verilog-mode)
;; Ditto files already read in
- (mapc (lambda (buf)
- (when (buffer-file-name buf)
- (with-current-buffer buf
- (verilog-mode))))
- (buffer-list))
- ;; Process the files
- (mapcar (lambda (buf)
+ ;; Remember buffer list, so don't later pickup any verilog-getopt files
+ (let ((orig-buffer-list (buffer-list)))
+ (mapc (lambda (buf)
(when (buffer-file-name buf)
- (save-excursion
- (if (not (file-exists-p (buffer-file-name buf)))
- (error
- (concat "File not found: " (buffer-file-name buf))))
- (message (concat "Processing " (buffer-file-name buf)))
- (set-buffer buf)
- (funcall funref)
- (unless no-save (save-buffer)))))
- (buffer-list))))
+ (with-current-buffer buf
+ (verilog-mode)
+ (verilog-auto-reeval-locals)
+ (verilog-getopt-flags))))
+ orig-buffer-list)
+ ;; Process the files
+ (mapcar (lambda (buf)
+ (when (buffer-file-name buf)
+ (save-excursion
+ (if (not (file-exists-p (buffer-file-name buf)))
+ (error
+ (concat "File not found: " (buffer-file-name buf))))
+ (message (concat "Processing " (buffer-file-name buf)))
+ (set-buffer buf)
+ (funcall funref)
+ (when (and (not no-save)
+ (buffer-modified-p)) ;; Avoid "no changes to be saved"
+ (save-buffer)))))
+ orig-buffer-list))))
(defun verilog-batch-auto ()
"For use with --batch, perform automatic expansions as a stand-alone tool.
@@ -5271,7 +5297,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(if (save-excursion (beginning-of-line)
(and (looking-at verilog-directive-re-1)
(not (or (looking-at "[ \t]*`[ou]vm_")
- (looking-at "[ \t]*`vmm_")))))
+ (looking-at "[ \t]*`vmm_")))))
(throw 'nesting 'directive))
;; indent structs as if there were module level
(setq structres (verilog-in-struct-nested-p))
@@ -5510,10 +5536,10 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
; endfunction
(verilog-beg-of-statement)
(if (looking-at verilog-beg-block-re-ordered)
- (throw 'nesting 'block)
- (throw 'nesting 'defun)))
+ (throw 'nesting 'block)
+ (throw 'nesting 'defun)))
- ;;
+ ;;
((looking-at "\\<property\\>")
; *sigh*
; {assert|assume|cover} property (); are complete
@@ -5704,7 +5730,7 @@ Jump from end to matching begin, from endcase to matching case, and so on."
(setq sreg reg)
(setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
)))
- ;no nesting
+ ;; no nesting
(if (and
(verilog-re-search-backward reg nil 'move)
(match-end 1)) ; task -> could be virtual and/or protected
@@ -6547,10 +6573,9 @@ Be verbose about progress unless optional QUIET set."
endpos (set-marker (make-marker) end)
base-ind (progn
(goto-char start)
- (forward-char 1)
- (skip-chars-forward " \t")
- (current-column))
- )
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (current-column)))
;; in a declaration block (not in argument list)
(setq
start (progn
@@ -8065,7 +8090,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
Return an array of [outputs inouts inputs wire reg assign const]."
(let ((end-mod-point (or (verilog-get-end-of-defun) (point-max)))
(functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t)
- in-modport in-clocking ptype ign-prop
+ in-modport in-clocking in-ign-to-semi ptype ign-prop
sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const
sigs-gparam sigs-intf sigs-modports
vec expect-signal keywd newsig rvalue enum io signed typedefed multidim
@@ -8097,19 +8122,24 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first
(error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
((eq ?\; (following-char))
- (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration
- (verilog-modport-decls-set
- in-modport
- (verilog-decls-new sigs-out sigs-inout sigs-in
- nil nil nil nil nil nil))
- ;; Pop from varstack to restore state to pre-clocking
- (setq tmp (car varstack)
- varstack (cdr varstack)
- sigs-out (aref tmp 0)
- sigs-inout (aref tmp 1)
- sigs-in (aref tmp 2)))
- (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
- v2kargs-ok nil in-modport nil ign-prop nil)
+ (cond (in-ign-to-semi ;; Such as inside a "import ...;" in a module header
+ (setq in-ign-to-semi nil))
+ ((and in-modport (not (eq in-modport t))) ;; end of a modport declaration
+ (verilog-modport-decls-set
+ in-modport
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2))
+ (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
+ v2kargs-ok nil in-modport nil ign-prop nil))
+ (t
+ (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
+ v2kargs-ok nil in-modport nil ign-prop nil)))
(forward-char 1))
((eq ?= (following-char))
(setq rvalue t newsig nil)
@@ -8212,8 +8242,12 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(setq in-modport t))
((equal keywd "clocking")
(setq in-clocking t))
+ ((equal keywd "import")
+ (if v2kargs-ok ;; import in module header, not a modport import
+ (setq in-ign-to-semi t rvalue t)))
((equal keywd "type")
(setq ptype t))
+ ((equal keywd "var"))
;; Ifdef? Ignore name of define
((member keywd '("`ifdef" "`ifndef" "`elsif"))
(setq rvalue t))
@@ -8285,6 +8319,7 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(eq functask 0)
(not (member keywd verilog-keywords)))
;; Add new signal to expect-signal's variable
+ ;;(if dbg (setq dbg (concat dbg (format "Pt %s New sig %s'\n" (point) keywd))))
(setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport))
(set expect-signal (cons newsig
(symbol-value expect-signal))))))
@@ -9138,7 +9173,7 @@ foo.v (an include file):
`define _FOO_V
... contents of file
`endif // _FOO_V"
-;;slow: (verilog-read-defines nil t))
+ ;;slow: (verilog-read-defines nil t)
(save-excursion
(verilog-getopt-flags)
(goto-char (point-min))
@@ -9527,7 +9562,7 @@ variables to build the path. With optional CHECK-EXT also check
(setq outlist (cons (expand-file-name
fn (file-name-directory current))
outlist)))
- (setq chkexts (cdr chkexts)))
+ (setq chkexts (cdr chkexts)))
(setq chkdirs (cdr chkdirs)))
(setq outlist (nreverse outlist))
(setq verilog-dir-cache-lib-filenames
@@ -9624,7 +9659,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
allow-cache
(setq modi (gethash module verilog-modi-lookup-cache))
(equal verilog-modi-lookup-last-current current)
- ;; Iff hit is in current buffer, then tick must match
+ ;; If hit is in current buffer, then tick must match
(or (equal verilog-modi-lookup-last-tick (buffer-chars-modified-tick))
(not (equal current (verilog-modi-file-or-buffer modi)))))
;;(message "verilog-modi-lookup: HIT %S" modi)
@@ -10602,7 +10637,7 @@ If FORCE, always reread it."
;;
(defun verilog-auto-arg-ports (sigs message indent-pt)
- "Print a list of ports for an AUTOINST.
+ "Print a list of ports for AUTOARG.
Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(when sigs
(when verilog-auto-arg-sort
@@ -10614,13 +10649,19 @@ Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(let ((space ""))
(indent-to indent-pt)
(while sigs
- (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
+ (cond ((equal verilog-auto-arg-format 'single)
+ (indent-to indent-pt)
+ (setq space "\n"))
+ ;; verilog-auto-arg-format 'packed
+ ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
(insert "\n")
- (indent-to indent-pt))
- (t (insert space)))
+ (indent-to indent-pt)
+ (setq space " "))
+ (t
+ (insert space)
+ (setq space " ")))
(insert (verilog-sig-name (car sigs)) ",")
- (setq sigs (cdr sigs)
- space " ")))))
+ (setq sigs (cdr sigs))))))
(defun verilog-auto-arg ()
"Expand AUTOARG statements.
@@ -10655,9 +10696,11 @@ Typing \\[verilog-auto] will make this into:
output o;
endmodule
-The argument declarations may be printed in declaration order to best suit
-order based instantiations, or alphabetically, based on the
-`verilog-auto-arg-sort' variable.
+The argument declarations may be printed in declaration order to
+best suit order based instantiations, or alphabetically, based on
+the `verilog-auto-arg-sort' variable.
+
+Formatting is controlled with `verilog-auto-arg-format' variable.
Any ports declared between the ( and /*AUTOARG*/ are presumed to be
predeclared and are not redeclared by AUTOARG. AUTOARG will make a
@@ -12071,7 +12114,7 @@ against the previous example's module:
(verilog-signals-matching-regexp sig-list-if regexp)
"interface" direction-re))
(when v2k (verilog-repair-open-comma))
- (when (or sig-list-i sig-list-o sig-list-io)
+ (when (or sig-list-i sig-list-o sig-list-io sig-list-if)
(verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
;; Don't sort them so an upper AUTOINST will match the main module
(verilog-insert-definition modi sig-list-o "output" indent-pt v2k t)
@@ -13538,8 +13581,7 @@ for sensitivity list."
()
> "begin" '(verilog-sk-prompt-name) \n
> _ \n
- > (- verilog-indent-level-behavioral) "end"
-)
+ > (- verilog-indent-level-behavioral) "end" )
(define-skeleton verilog-sk-fork
"Insert a fork join block."
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index b422cf6c989..3d5a3980a94 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -13,10 +13,10 @@
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
-(defconst vhdl-version "3.34.2"
+(defconst vhdl-version "3.35.2"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2012-11-21"
+(defconst vhdl-time-stamp "2014-03-28"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
@@ -72,12 +72,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; this updated version was only tested on: GNU Emacs 20.4
+;; this updated version was only tested on: GNU Emacs 24.1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
@@ -392,7 +392,8 @@ File message:
Unit-to-file name mapping: mapping of library unit names to names of files
generated by the compiler (used for Makefile generation)
To string : string a name is mapped to (\"\\1\" inserts the unit name,
- \"\\2\" inserts the entity name for architectures)
+ \"\\2\" inserts the entity name for architectures,
+ \"\\3\" inserts the library name)
Case adjustment : adjust case of inserted unit names
\(*) The regular expression must match the error message starting from the
@@ -1069,7 +1070,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
"Customizations for sequential processes."
:group 'vhdl-template)
-(defcustom vhdl-reset-kind 'async
+(defcustom vhdl-reset-kind 'async
"Specifies which kind of reset to use in sequential processes."
:type '(choice (const :tag "None" none)
(const :tag "Synchronous" sync)
@@ -2125,7 +2126,6 @@ your style, only those that are different from the default.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mandatory
-(require 'assoc)
(require 'compile) ; XEmacs
(require 'easymenu)
(require 'hippie-exp)
@@ -2137,6 +2137,73 @@ your style, only those that are different from the default.")
(require 'ps-print)
(require 'speedbar))) ; for speedbar-with-writable
+;; functions from obsolete assoc.el package (obsoleted in GNU Emacs 24.3)
+(defun vhdl-asort (alist-symbol key)
+ "Move a specified key-value pair to the head of an alist.
+The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
+head is one matching KEY. Returns the sorted list and doesn't affect
+the order of any other key-value pair. Side effect sets alist to new
+sorted list."
+ (set alist-symbol
+ (sort (copy-alist (symbol-value alist-symbol))
+ (lambda (a _b) (equal (car a) key)))))
+
+(defun vhdl-anot-head-p (alist key)
+ "Find out if a specified key-value pair is not at the head of an alist.
+The alist to check is specified by ALIST and the key-value pair is the
+one matching the supplied KEY. Returns nil if ALIST is nil, or if
+key-value pair is at the head of the alist. Returns t if key-value
+pair is not at the head of alist. ALIST is not altered."
+ (not (equal (car (car alist)) key)))
+
+(defun vhdl-aput (alist-symbol key &optional value)
+ "Insert a key-value pair into an alist.
+The alist is referenced by ALIST-SYMBOL. The key-value pair is made
+from KEY and optionally, VALUE. Returns the altered alist.
+
+If the key-value pair referenced by KEY can be found in the alist, and
+VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
+If VALUE is not supplied, or is nil, the key-value pair will not be
+modified, but will be moved to the head of the alist. If the key-value
+pair cannot be found in the alist, it will be inserted into the head
+of the alist (with value nil if VALUE is nil or not supplied)."
+ (let ((elem (list (cons key value)))
+ alist)
+ (vhdl-asort alist-symbol key)
+ (setq alist (symbol-value alist-symbol))
+ (cond ((null alist) (set alist-symbol elem))
+ ((vhdl-anot-head-p alist key) (set alist-symbol (nconc elem alist)))
+ (value (setcar alist (car elem)) alist)
+ (t alist))))
+
+(defun vhdl-adelete (alist-symbol key)
+ "Delete a key-value pair from the alist.
+Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
+is pair matching KEY. Returns the altered alist."
+ (vhdl-asort alist-symbol key)
+ (let ((alist (symbol-value alist-symbol)))
+ (cond ((null alist) nil)
+ ((vhdl-anot-head-p alist key) alist)
+ (t (set alist-symbol (cdr alist))))))
+
+(defun vhdl-aget (alist key &optional keynil-p)
+ "Return the value in ALIST that is associated with KEY.
+Optional KEYNIL-P describes what to do if the value associated with
+KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is
+nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be
+returned.
+
+If no key-value pair matching KEY could be found in ALIST, or ALIST is
+nil then nil is returned. ALIST is not altered."
+ (let ((copy (copy-alist alist)))
+ (cond ((null alist) nil)
+ ((progn (vhdl-asort 'copy key)
+ (vhdl-anot-head-p copy key)) nil)
+ ((cdr (car copy)))
+ (keynil-p nil)
+ ((car (car copy)))
+ (t nil))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility
@@ -2256,7 +2323,6 @@ Ignore byte-compiler warnings you might see."
"Wait until idle, then run FUNCTION."
(if (fboundp 'start-itimer)
(start-itimer "vhdl-mode" function secs repeat t)
-; (run-with-idle-timer secs repeat function)))
;; explicitly activate timer (necessary when Emacs is already idle)
(aset (run-with-idle-timer secs repeat function) 0 nil)))
@@ -2429,7 +2495,7 @@ specified."
current buffer if no project is defined."
(if (vhdl-project-p)
(expand-file-name (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist vhdl-project))))
+ (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
default-directory))
(defmacro vhdl-prepare-search-1 (&rest body)
@@ -2537,11 +2603,11 @@ conversion."
(setq file-list (cdr file-list)))
dir-list))
-(defun vhdl-aput (alist-symbol key &optional value)
+(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
"As `aput', but delete key-value pair if VALUE is nil."
(if value
- (aput alist-symbol key value)
- (adelete alist-symbol key)))
+ (vhdl-aput alist-symbol key value)
+ (vhdl-adelete alist-symbol key)))
(defun vhdl-delete (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
@@ -2596,11 +2662,6 @@ conversion."
(set-buffer (marker-buffer marker)))
(goto-char marker))
-(defun vhdl-goto-line (line)
- "Use this instead of calling user level function `goto-line'."
- (goto-char (point-min))
- (forward-line (1- line)))
-
(defun vhdl-menu-split (list title)
"Split menu LIST into several submenus, if number of
elements > `vhdl-menu-max-size'."
@@ -2975,7 +3036,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(make-variable-buffer-local 'vhdl-syntactic-context)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Abbrev ook bindings
+;; Abbrev hook bindings
(defvar vhdl-mode-abbrev-table nil
"Abbrev table to use in `vhdl-mode' buffers.")
@@ -2985,8 +3046,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
(define-abbrev-table 'vhdl-mode-abbrev-table
(append
(when (memq 'vhdl vhdl-electric-keywords)
- ;; VHDL'93 keywords
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ ;; VHDL'02 keywords
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("--" . vhdl-template-display-comment-hook)
("abs" . vhdl-template-default-hook)
@@ -3102,7 +3165,9 @@ STRING are replaced by `-' and substrings are converted to lower case."
)))
;; VHDL-AMS keywords
(when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("across" . vhdl-template-default-hook)
("break" . vhdl-template-break-hook)
@@ -4822,7 +4887,7 @@ Key bindings:
;; set local variables
(set (make-local-variable 'paragraph-start)
- "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
+ "\\s-*\\(--+\\s-*$\\|$\\)")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
@@ -4860,9 +4925,7 @@ Key bindings:
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
(set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
-; (set (make-local-variable 'lazy-lock-defer-time) 0.1)
(set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
-; (turn-on-font-lock)
;; variables for source file compilation
(when vhdl-compile-use-local-error-regexp
@@ -7566,7 +7629,6 @@ indentation is done before aligning."
(setq end (point-marker))
(goto-char begin)
(setq bol (setq begin (progn (beginning-of-line) (point))))
-; (untabify bol end)
(when indent
(indent-region bol end nil))))
(let ((copy (copy-alist alignment-list)))
@@ -7962,7 +8024,6 @@ end of line, do nothing in comments and strings."
(and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
(progn (replace-match " " nil nil) t))
(and (looking-at "-") (re-search-forward "-" end t))
-; (re-search-forward "[^ \t-]+" end t))))
(re-search-forward "[^ \t\"-]+" end t))))
(unless no-message (message "Fixing up whitespace...done")))
@@ -8080,7 +8141,7 @@ Currently supported keywords: 'begin', 'if'."
(while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
(goto-char (match-end 1))
(setq point (point-marker))
- ;; exception: in literal or preceded by `end' or label
+ ;; exception: in literal or preceded by `end', `wait' or label
(when (and (not (save-excursion (goto-char (match-beginning 1))
(vhdl-in-literal)))
(save-excursion
@@ -8089,7 +8150,7 @@ Currently supported keywords: 'begin', 'if'."
(and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
(match-beginning 1) t)
(not (string-match
- "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$"
+ "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
(match-string 1)))))))
(goto-char (match-beginning 1))
(insert "\n")
@@ -8138,10 +8199,12 @@ case fixing to a region. Calls functions `vhdl-indent-buffer',
(when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
(when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
(when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
- (let ((vhdl-align-groups t))
- (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end)))
+ (when (nth 3 vhdl-beautify-options)
+ (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
(when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
- (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end)))
+ (when (nth 0 vhdl-beautify-options)
+ (vhdl-remove-trailing-spaces-region beg end)
+ (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
(defun vhdl-beautify-buffer ()
"Beautify buffer by applying indentation, whitespace fixup, alignment, and
@@ -8447,11 +8510,11 @@ buffer."
(setq beg (point))))))
;; search for signals declared in surrounding block declarative parts
(save-excursion
- (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
- (match-string 2))
- (goto-char (match-end 2))
+ (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
+ (match-string 4))
+ (goto-char (match-end 4))
(vhdl-backward-sexp)
- (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
+ (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
beg)
(setq end (re-search-forward "^\\s-*begin\\>" nil t)))
;; scan for all declared signal names
@@ -8548,7 +8611,8 @@ Used for undoing after template abortion.")
"Return the working library name of the current project or \"work\" if no
project is defined."
(vhdl-resolve-env-variable
- (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
+ (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
+ vhdl-default-library)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Enabling/disabling
@@ -8966,8 +9030,6 @@ since these are almost equivalent)."
(interactive)
(when (vhdl-template-field "target signal")
(insert " <= ")
-; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
-; (insert " "))
(let ((margin (current-column))
(start (point))
position)
@@ -9903,7 +9965,7 @@ otherwise."
(defun vhdl-template-record (kind &optional name secondary)
"Insert a record type declaration."
(interactive)
- (let ((margin (current-column))
+ (let ((margin (current-indentation))
(start (point))
(first t))
(vhdl-insert-keyword "RECORD\n")
@@ -9965,7 +10027,6 @@ otherwise."
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "target signal" " <= ")
-; (vhdl-template-field "[GUARDED] [TRANSPORT]")
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "waveform")
@@ -10466,8 +10527,10 @@ specification, if not already there."
(defun vhdl-template-replace-header-keywords (beg end &optional file-title
is-model)
"Replace keywords in header and footer."
- (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
- (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
+ (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
+ (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
pos)
(vhdl-prepare-search-2
(save-excursion
@@ -10525,9 +10588,9 @@ specification, if not already there."
(replace-match file-title t t))
(goto-char beg))
(let (string)
- (while
- (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
- (setq string (read-string (concat (match-string 1) ": ")))
+ (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
+ (save-match-data
+ (setq string (read-string (concat (match-string 1) ": "))))
(replace-match string t t)))
(goto-char beg)
(when (and (not is-model) (search-forward "<cursor>" end t))
@@ -10635,14 +10698,7 @@ If starting after end-comment-column, start a new line."
(if (not (or (and string (progn (insert string) t))
(vhdl-template-field "[comment]" nil t)))
(delete-region position (point))
- (while (= (preceding-char) ?\ ) (delete-char -1))
- ;; (when (> (current-column) end-comment-column)
- ;; (setq position (point-marker))
- ;; (re-search-backward "-- ")
- ;; (insert "\n")
- ;; (indent-to comment-column)
- ;; (goto-char position))
- ))))
+ (while (= (preceding-char) ?\ ) (delete-char -1))))))
(defun vhdl-comment-block ()
"Insert comment for code block."
@@ -10882,8 +10938,6 @@ Point is left between them."
(defun vhdl-template-generate-body (margin label)
"Insert body for generate template."
(vhdl-insert-keyword " GENERATE")
-; (if (not (vhdl-standard-p '87))
-; (vhdl-template-begin-end "GENERATE" label margin)
(insert "\n\n")
(indent-to margin)
(vhdl-insert-keyword "END GENERATE ")
@@ -11670,7 +11724,6 @@ reflected in a subsequent paste operation."
comment group-comment))))
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))))
-; (vhdl-parse-string "end\\>")
;; parse context clause
(setq context-clause (vhdl-scan-context-clause))
; ;; add surrounding package to context clause
@@ -12622,7 +12675,6 @@ reflected in a subsequent paste operation."
(while (and he-expand-list
(or (not (stringp (car he-expand-list)))
(he-string-member (car he-expand-list) he-tried-table t)))
-; (equal (car he-expand-list) he-search-string)))
(unless (stringp (car he-expand-list))
(setq vhdl-expand-upper-case (car he-expand-list)))
(setq he-expand-list (cdr he-expand-list)))
@@ -12908,8 +12960,8 @@ File statistics: \"%s\"\n\
";; project name\n"
"(setq vhdl-project \"" vhdl-project "\")\n\n"
";; project setup\n"
- "(aput 'vhdl-project-alist vhdl-project\n'")
- (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
+ "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
+ (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
(insert ")\n")
(save-buffer)
(kill-buffer (current-buffer))
@@ -12929,8 +12981,8 @@ File statistics: \"%s\"\n\
(condition-case ()
(let ((current-project vhdl-project))
(load-file file-name)
- (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
- (adelete 'vhdl-project-alist vhdl-project)
+ (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project t)) 10)
+ (vhdl-adelete 'vhdl-project-alist vhdl-project)
(error ""))
(when not-make-current
(setq vhdl-project current-project))
@@ -12946,7 +12998,7 @@ File statistics: \"%s\"\n\
"Duplicate setup of current project."
(interactive)
(let ((new-name (read-from-minibuffer "New project name: "))
- (project-entry (aget vhdl-project-alist vhdl-project t)))
+ (project-entry (vhdl-aget vhdl-project-alist vhdl-project t)))
(setq vhdl-project-alist
(append vhdl-project-alist
(list (cons new-name project-entry))))
@@ -13275,7 +13327,6 @@ This does highlighting of keywords and standard identifiers.")
(skip-syntax-backward " ")
(skip-syntax-backward "w_")
(skip-syntax-backward " ")))
-; (skip-chars-backward "^-(\n\";")
(goto-char (match-end 1)) (1 font-lock-variable-name-face)))
;; highlight formal parameters in component instantiations and subprogram
@@ -13676,8 +13727,6 @@ hierarchy otherwise.")
non-final)
"Scan contents of VHDL files in directory or file pattern NAME."
(string-match "\\(.*[/\\]\\)\\(.*\\)" name)
-; (unless (file-directory-p (match-string 1 name))
-; (message "No such directory: \"%s\"" (match-string 1 name)))
(let* ((dir-name (match-string 1 name))
(file-pattern (match-string 2 name))
(is-directory (= 0 (length file-pattern)))
@@ -13690,18 +13739,18 @@ hierarchy otherwise.")
dir-name t (wildcard-to-regexp file-pattern)))))
(key (or project dir-name))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
(limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
(limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
(limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
ent-alist conf-alist pack-alist ent-inst-list file-alist
tmp-list tmp-entry no-files files-exist big-files)
(when (or project update)
- (setq ent-alist (aget vhdl-entity-alist key t)
- conf-alist (aget vhdl-config-alist key t)
- pack-alist (aget vhdl-package-alist key t)
- ent-inst-list (car (aget vhdl-ent-inst-alist key t))
- file-alist (aget vhdl-file-alist key t)))
+ (setq ent-alist (vhdl-aget vhdl-entity-alist key t)
+ conf-alist (vhdl-aget vhdl-config-alist key t)
+ pack-alist (vhdl-aget vhdl-package-alist key t)
+ ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key t))
+ file-alist (vhdl-aget vhdl-file-alist key t)))
(when (and (not is-directory) (null file-list))
(message "No such file: \"%s\"" name))
(setq files-exist file-list)
@@ -13743,7 +13792,7 @@ hierarchy otherwise.")
(while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 1))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key t))
(lib-alist (vhdl-scan-context-clause)))
(if (nth 1 ent-entry)
(vhdl-warning-when-idle
@@ -13751,10 +13800,10 @@ hierarchy otherwise.")
ent-name (nth 1 ent-entry) (nth 2 ent-entry)
file-name (vhdl-current-line))
(push ent-key ent-list)
- (aput 'ent-alist ent-key
- (list ent-name file-name (vhdl-current-line)
- (nth 3 ent-entry) (nth 4 ent-entry)
- lib-alist)))))
+ (vhdl-aput 'ent-alist ent-key
+ (list ent-name file-name (vhdl-current-line)
+ (nth 3 ent-entry) (nth 4 ent-entry)
+ lib-alist)))))
;; scan for architectures
(goto-char (point-min))
(while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
@@ -13762,9 +13811,9 @@ hierarchy otherwise.")
(arch-key (downcase arch-name))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key t))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key t))
(lib-arch-alist (vhdl-scan-context-clause)))
(if arch-entry
(vhdl-warning-when-idle
@@ -13773,20 +13822,20 @@ hierarchy otherwise.")
(nth 2 arch-entry) file-name (vhdl-current-line))
(setq arch-list (cons arch-key arch-list)
arch-ent-list (cons ent-key arch-ent-list))
- (aput 'arch-alist arch-key
- (list arch-name file-name (vhdl-current-line) nil
- lib-arch-alist))
- (aput 'ent-alist ent-key
- (list (or (nth 0 ent-entry) ent-name)
- (nth 1 ent-entry) (nth 2 ent-entry)
- (vhdl-sort-alist arch-alist)
- arch-key (nth 5 ent-entry))))))
+ (vhdl-aput 'arch-alist arch-key
+ (list arch-name file-name (vhdl-current-line)
+ nil lib-arch-alist))
+ (vhdl-aput 'ent-alist ent-key
+ (list (or (nth 0 ent-entry) ent-name)
+ (nth 1 ent-entry) (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ arch-key (nth 5 ent-entry))))))
;; scan for configurations
(goto-char (point-min))
(while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((conf-name (match-string-no-properties 1))
(conf-key (downcase conf-name))
- (conf-entry (aget conf-alist conf-key t))
+ (conf-entry (vhdl-aget conf-alist conf-key t))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(lib-alist (vhdl-scan-context-clause))
@@ -13827,16 +13876,16 @@ hierarchy otherwise.")
inst-lib-key)
comp-conf-list))
(setq inst-key-list (cdr inst-key-list)))))
- (aput 'conf-alist conf-key
- (list conf-name file-name conf-line ent-key
- arch-key comp-conf-list lib-alist)))))
+ (vhdl-aput 'conf-alist conf-key
+ (list conf-name file-name conf-line ent-key
+ arch-key comp-conf-list lib-alist)))))
;; scan for packages
(goto-char (point-min))
(while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((pack-name (match-string-no-properties 2))
(pack-key (downcase pack-name))
(is-body (match-string-no-properties 1))
- (pack-entry (aget pack-alist pack-key t))
+ (pack-entry (vhdl-aget pack-alist pack-key t))
(pack-line (vhdl-current-line))
(end-of-unit (vhdl-get-end-of-unit))
comp-name func-name comp-alist func-alist lib-alist)
@@ -13867,7 +13916,7 @@ hierarchy otherwise.")
(if is-body
(push pack-key pack-body-list)
(push pack-key pack-list))
- (aput
+ (vhdl-aput
'pack-alist pack-key
(if is-body
(list (or (nth 0 pack-entry) pack-name)
@@ -13891,9 +13940,9 @@ hierarchy otherwise.")
(ent-key (downcase ent-name))
(arch-name (match-string-no-properties 1))
(arch-key (downcase arch-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key t))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key t))
(beg-of-unit (point))
(end-of-unit (vhdl-get-end-of-unit))
(inst-no 0)
@@ -13907,7 +13956,10 @@ hierarchy otherwise.")
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
"\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
(or (not limit-hier-inst-no)
- (<= (setq inst-no (1+ inst-no))
+ (<= (if (or (match-string 14)
+ (match-string 16))
+ inst-no
+ (setq inst-no (1+ inst-no)))
limit-hier-inst-no)))
(cond
;; block/generate beginning found
@@ -13988,23 +14040,25 @@ hierarchy otherwise.")
(setcar tmp-inst-alist inst-entry))
(setq tmp-inst-alist (cdr tmp-inst-alist)))))
;; save in cache
- (aput 'arch-alist arch-key
- (list (nth 0 arch-entry) (nth 1 arch-entry)
- (nth 2 arch-entry) inst-alist
- (nth 4 arch-entry)))
- (aput 'ent-alist ent-key
- (list (nth 0 ent-entry) (nth 1 ent-entry)
- (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
- (nth 4 ent-entry) (nth 5 ent-entry)))
+ (vhdl-aput 'arch-alist arch-key
+ (list (nth 0 arch-entry) (nth 1 arch-entry)
+ (nth 2 arch-entry) inst-alist
+ (nth 4 arch-entry)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 ent-entry) (nth 1 ent-entry)
+ (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ (nth 4 ent-entry) (nth 5 ent-entry)))
(when (and limit-hier-inst-no
(> inst-no limit-hier-inst-no))
(message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name)
(setq big-files t))
(goto-char end-of-unit))))
;; remember design units for this file
- (aput 'file-alist file-name
- (list ent-list arch-list arch-ent-list conf-list
- pack-list pack-body-list inst-list inst-ent-list))
+ (vhdl-aput 'file-alist file-name
+ (list ent-list arch-list arch-ent-list conf-list
+ pack-list pack-body-list
+ inst-list inst-ent-list))
(setq ent-inst-list (append inst-ent-list ent-inst-list))))))
(setq file-list (cdr file-list))))
(when (or (and (not project) files-exist)
@@ -14023,8 +14077,8 @@ hierarchy otherwise.")
;; check whether configuration has a corresponding entity/architecture
(setq tmp-list conf-alist)
(while tmp-list
- (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
- (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
+ (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)) t))
+ (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
(setq tmp-entry (car tmp-list))
(vhdl-warning-when-idle
"Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
@@ -14053,17 +14107,17 @@ hierarchy otherwise.")
(add-to-list 'vhdl-updated-project-list (or project dir-name)))
;; clear directory alists
(unless project
- (adelete 'vhdl-entity-alist key)
- (adelete 'vhdl-config-alist key)
- (adelete 'vhdl-package-alist key)
- (adelete 'vhdl-ent-inst-alist key)
- (adelete 'vhdl-file-alist key))
+ (vhdl-adelete 'vhdl-entity-alist key)
+ (vhdl-adelete 'vhdl-config-alist key)
+ (vhdl-adelete 'vhdl-package-alist key)
+ (vhdl-adelete 'vhdl-ent-inst-alist key)
+ (vhdl-adelete 'vhdl-file-alist key))
;; put directory contents into cache
- (aput 'vhdl-entity-alist key ent-alist)
- (aput 'vhdl-config-alist key conf-alist)
- (aput 'vhdl-package-alist key pack-alist)
- (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
- (aput 'vhdl-file-alist key file-alist)
+ (vhdl-aput 'vhdl-entity-alist key ent-alist)
+ (vhdl-aput 'vhdl-config-alist key conf-alist)
+ (vhdl-aput 'vhdl-package-alist key pack-alist)
+ (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
+ (vhdl-aput 'vhdl-file-alist key file-alist)
;; final messages
(message "Scanning %s %s\"%s\"...done"
(if is-directory "directory" "files") (or num-string "") name)
@@ -14079,18 +14133,18 @@ hierarchy otherwise.")
(defun vhdl-scan-project-contents (project)
"Scan the contents of all VHDL files found in the directories and files
of PROJECT."
- (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
+ (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
(default-dir (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist project))))
+ (nth 1 (vhdl-aget vhdl-project-alist project))))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
dir-list-tmp dir dir-name num-dir act-dir recursive)
;; clear project alists
- (adelete 'vhdl-entity-alist project)
- (adelete 'vhdl-config-alist project)
- (adelete 'vhdl-package-alist project)
- (adelete 'vhdl-ent-inst-alist project)
- (adelete 'vhdl-file-alist project)
+ (vhdl-adelete 'vhdl-entity-alist project)
+ (vhdl-adelete 'vhdl-config-alist project)
+ (vhdl-adelete 'vhdl-package-alist project)
+ (vhdl-adelete 'vhdl-ent-inst-alist project)
+ (vhdl-adelete 'vhdl-file-alist project)
;; expand directory names by default-directory
(message "Collecting source files...")
(while dir-list
@@ -14137,7 +14191,7 @@ of PROJECT."
(add-to-list 'dir-list-tmp (file-name-directory dir-name))
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
- (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
+ (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
(message "Scanning project \"%s\"...done" project)))
(defun vhdl-update-file-contents (file-name)
@@ -14150,13 +14204,16 @@ of PROJECT."
(when (member dir-name (nth 1 (car directory-alist)))
(let* ((vhdl-project (nth 0 (car directory-alist)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
- (conf-alist (aget vhdl-config-alist (or project dir-name) t))
- (pack-alist (aget vhdl-package-alist (or project dir-name) t))
- (ent-inst-list (car (aget vhdl-ent-inst-alist
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project dir-name) t))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or project dir-name) t))
+ (pack-alist (vhdl-aget vhdl-package-alist
+ (or project dir-name) t))
+ (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
(or project dir-name) t)))
- (file-alist (aget vhdl-file-alist (or project dir-name) t))
- (file-entry (aget file-alist file-name t))
+ (file-alist (vhdl-aget vhdl-file-alist (or project dir-name) t))
+ (file-entry (vhdl-aget file-alist file-name t))
(ent-list (nth 0 file-entry))
(arch-list (nth 1 file-entry))
(arch-ent-list (nth 2 file-entry))
@@ -14170,57 +14227,57 @@ of PROJECT."
;; entities
(while ent-list
(setq key (car ent-list)
- entry (aget ent-alist key t))
+ entry (vhdl-aget ent-alist key t))
(when (equal file-name (nth 1 entry))
(if (nth 3 entry)
- (aput 'ent-alist key
- (list (nth 0 entry) nil nil (nth 3 entry) nil))
- (adelete 'ent-alist key)))
+ (vhdl-aput 'ent-alist key
+ (list (nth 0 entry) nil nil (nth 3 entry) nil))
+ (vhdl-adelete 'ent-alist key)))
(setq ent-list (cdr ent-list)))
;; architectures
(while arch-list
(setq key (car arch-list)
ent-key (car arch-ent-list)
- entry (aget ent-alist ent-key t)
+ entry (vhdl-aget ent-alist ent-key t)
arch-alist (nth 3 entry))
- (when (equal file-name (nth 1 (aget arch-alist key t)))
- (adelete 'arch-alist key)
+ (when (equal file-name (nth 1 (vhdl-aget arch-alist key t)))
+ (vhdl-adelete 'arch-alist key)
(if (or (nth 1 entry) arch-alist)
- (aput 'ent-alist ent-key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- arch-alist (nth 4 entry) (nth 5 entry)))
- (adelete 'ent-alist ent-key)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ arch-alist (nth 4 entry) (nth 5 entry)))
+ (vhdl-adelete 'ent-alist ent-key)))
(setq arch-list (cdr arch-list)
arch-ent-list (cdr arch-ent-list)))
;; configurations
(while conf-list
(setq key (car conf-list))
- (when (equal file-name (nth 1 (aget conf-alist key t)))
- (adelete 'conf-alist key))
+ (when (equal file-name (nth 1 (vhdl-aget conf-alist key t)))
+ (vhdl-adelete 'conf-alist key))
(setq conf-list (cdr conf-list)))
;; package declarations
(while pack-list
(setq key (car pack-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key t))
(when (equal file-name (nth 1 entry))
(if (nth 6 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) nil nil nil nil nil
- (nth 6 entry) (nth 7 entry) (nth 8 entry)
- (nth 9 entry)))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) nil nil nil nil nil
+ (nth 6 entry) (nth 7 entry) (nth 8 entry)
+ (nth 9 entry)))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-list (cdr pack-list)))
;; package bodies
(while pack-body-list
(setq key (car pack-body-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key t))
(when (equal file-name (nth 6 entry))
(if (nth 1 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- (nth 3 entry) (nth 4 entry) (nth 5 entry)
- nil nil nil nil))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ (nth 3 entry) (nth 4 entry) (nth 5 entry)
+ nil nil nil nil))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-body-list (cdr pack-body-list)))
;; instantiated entities
(while inst-ent-list
@@ -14228,10 +14285,10 @@ of PROJECT."
(vhdl-delete (car inst-ent-list) ent-inst-list))
(setq inst-ent-list (cdr inst-ent-list)))
;; update caches
- (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
- (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
- (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
- (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
+ (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
;; scan file
(vhdl-scan-directory-contents file-name project t)
(when (or (and vhdl-speedbar-show-projects project)
@@ -14264,8 +14321,8 @@ of PROJECT."
&optional include-top ent-hier)
"Get instantiation hierarchy beginning in architecture ARCH-KEY of
entity ENT-KEY."
- (let* ((ent-entry (aget ent-alist ent-key t))
- (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
+ (let* ((ent-entry (vhdl-aget ent-alist ent-key t))
+ (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key t)
(cdar (last (nth 3 ent-entry)))))
(inst-alist (nth 3 arch-entry))
inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
@@ -14276,9 +14333,6 @@ entity ENT-KEY."
(setq level (1+ level)))
(when (member ent-key ent-hier)
(error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
- ;; check configured architecture (already checked during scanning)
-; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
-; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
;; process all instances
(while inst-alist
(setq inst-entry (car inst-alist)
@@ -14294,27 +14348,27 @@ entity ENT-KEY."
(downcase (or inst-comp-name ""))))))
(setq tmp-list (cdr tmp-list)))
(setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
- (setq inst-conf-entry (aget conf-alist inst-conf-key t))
+ (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key t))
(when (and inst-conf-key (not inst-conf-entry))
(vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
;; determine entity
(setq inst-ent-key
(or (nth 2 (car tmp-list)) ; from configuration
(nth 3 inst-conf-entry) ; from subconfiguration
- (nth 3 (aget conf-alist (nth 7 inst-entry) t))
+ (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry) t))
; from configuration spec.
(nth 5 inst-entry))) ; from direct instantiation
- (setq inst-ent-entry (aget ent-alist inst-ent-key t))
+ (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key t))
;; determine architecture
(setq inst-arch-key
(or (nth 3 (car tmp-list)) ; from configuration
(nth 4 inst-conf-entry) ; from subconfiguration
(nth 6 inst-entry) ; from direct instantiation
- (nth 4 (aget conf-alist (nth 7 inst-entry)))
+ (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
; from configuration spec.
(nth 4 inst-ent-entry) ; MRA
(caar (nth 3 inst-ent-entry)))) ; first alphabetically
- (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
+ (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key t))
;; set library
(setq inst-lib-key
(or (nth 5 (car tmp-list)) ; from configuration
@@ -14353,7 +14407,8 @@ entity ENT-KEY."
(defun vhdl-get-instantiations (ent-key indent)
"Get all instantiations of entity ENT-KEY."
- (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (vhdl-speedbar-line-key indent) t))
arch-alist inst-alist ent-inst-list
ent-entry arch-entry inst-entry)
(while ent-alist
@@ -14439,29 +14494,29 @@ entity ENT-KEY."
(insert ")\n")
(when (member 'hierarchy vhdl-speedbar-save-cache)
(insert "\n;; entity and architecture cache\n"
- "(aput 'vhdl-entity-alist " key " '")
- (print (aget vhdl-entity-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-entity-alist " key " '")
+ (print (vhdl-aget vhdl-entity-alist cache-key t) (current-buffer))
(insert ")\n\n;; configuration cache\n"
- "(aput 'vhdl-config-alist " key " '")
- (print (aget vhdl-config-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-config-alist " key " '")
+ (print (vhdl-aget vhdl-config-alist cache-key t) (current-buffer))
(insert ")\n\n;; package cache\n"
- "(aput 'vhdl-package-alist " key " '")
- (print (aget vhdl-package-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-package-alist " key " '")
+ (print (vhdl-aget vhdl-package-alist cache-key t) (current-buffer))
(insert ")\n\n;; instantiated entities cache\n"
- "(aput 'vhdl-ent-inst-alist " key " '")
- (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-ent-inst-alist " key " '")
+ (print (vhdl-aget vhdl-ent-inst-alist cache-key t) (current-buffer))
(insert ")\n\n;; design units per file cache\n"
- "(aput 'vhdl-file-alist " key " '")
- (print (aget vhdl-file-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-file-alist " key " '")
+ (print (vhdl-aget vhdl-file-alist cache-key t) (current-buffer))
(when project
(insert ")\n\n;; source directories in project cache\n"
- "(aput 'vhdl-directory-alist " key " '")
- (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
+ "(vhdl-aput 'vhdl-directory-alist " key " '")
+ (print (vhdl-aget vhdl-directory-alist cache-key t) (current-buffer)))
(insert ")\n"))
(when (member 'display vhdl-speedbar-save-cache)
(insert "\n;; shown design units cache\n"
- "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
- (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
+ "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
+ (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key t)
(current-buffer))
(insert ")\n"))
(setq vhdl-updated-project-list
@@ -14528,7 +14583,6 @@ if required."
(defun vhdl-speedbar-initialize ()
"Initialize speedbar."
;; general settings
-; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil)
;; VHDL file extensions (extracted from `auto-mode-alist')
(let ((mode-alist auto-mode-alist))
(while mode-alist
@@ -14626,11 +14680,7 @@ if required."
(append
'(("vhdl directory" vhdl-speedbar-update-current-unit)
("vhdl project" vhdl-speedbar-update-current-project
- vhdl-speedbar-update-current-unit)
-; ("files" (lambda () (setq speedbar-ignored-path-regexp
-; (speedbar-extension-list-to-regex
-; speedbar-ignored-path-expressions))))
- )
+ vhdl-speedbar-update-current-unit))
speedbar-stealthy-function-list))
(when (eq vhdl-speedbar-display-mode 'directory)
(setq speedbar-initial-expansion-list-name "vhdl directory"))
@@ -14724,10 +14774,7 @@ if required."
(concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
(goto-char (match-end 1))
(speedbar-do-function-pointer)))
- (setq project-alist (cdr project-alist))))
-; (vhdl-speedbar-update-current-project)
-; (vhdl-speedbar-update-current-unit nil t)
- )
+ (setq project-alist (cdr project-alist)))))
(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
"Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil,
@@ -14737,10 +14784,10 @@ otherwise use cached data."
(vhdl-scan-project-contents project))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist project t)
- (aget vhdl-config-alist project t)
- (aget vhdl-package-alist project t)
- (car (aget vhdl-ent-inst-alist project t)) indent)
+ (vhdl-aget vhdl-entity-alist project t)
+ (vhdl-aget vhdl-config-alist project t)
+ (vhdl-aget vhdl-package-alist project t)
+ (car (vhdl-aget vhdl-ent-inst-alist project t)) indent)
(insert (int-to-string indent) ":\n")
(put-text-property (- (point) 3) (1- (point)) 'invisible t)
(put-text-property (1- (point)) (point) 'invisible nil)
@@ -14755,13 +14802,13 @@ otherwise use cached data."
(vhdl-scan-directory-contents directory))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist directory t)
- (aget vhdl-config-alist directory t)
- (aget vhdl-package-alist directory t)
- (car (aget vhdl-ent-inst-alist directory t)) depth)
+ (vhdl-aget vhdl-entity-alist directory t)
+ (vhdl-aget vhdl-config-alist directory t)
+ (vhdl-aget vhdl-package-alist directory t)
+ (car (vhdl-aget vhdl-ent-inst-alist directory t)) depth)
;; expand design units
(vhdl-speedbar-expand-units directory)
- (aput 'vhdl-directory-alist directory (list (list directory))))
+ (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
ent-inst-list depth)
@@ -14849,10 +14896,10 @@ otherwise use cached data."
(defun vhdl-speedbar-expand-units (key)
"Expand design units in directory/project KEY according to
`vhdl-speedbar-shown-unit-alist'."
- (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
+ (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))
(vhdl-speedbar-update-current-unit nil)
vhdl-updated-project-list)
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-prepare-search-1
(while unit-alist ; expand units
(vhdl-speedbar-goto-this-unit key (caar unit-alist))
@@ -14902,7 +14949,7 @@ otherwise use cached data."
(progn (setq vhdl-speedbar-shown-project-list nil)
(vhdl-speedbar-refresh))
(let ((key (vhdl-speedbar-line-key)))
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key)))))
@@ -14911,9 +14958,9 @@ otherwise use cached data."
"Expand all design units in current directory/project."
(interactive)
(let* ((key (vhdl-speedbar-line-key))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
- (pack-alist (aget vhdl-package-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key t))
+ (conf-alist (vhdl-aget vhdl-config-alist key t))
+ (pack-alist (vhdl-aget vhdl-package-alist key t))
arch-alist unit-alist subunit-alist)
(add-to-list 'vhdl-speedbar-shown-project-list key)
(while ent-alist
@@ -14930,7 +14977,7 @@ otherwise use cached data."
(while pack-alist
(push (list (caar pack-alist)) unit-alist)
(setq pack-alist (cdr pack-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(vhdl-speedbar-refresh)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -14965,8 +15012,8 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand entity
(let* ((key (vhdl-speedbar-line-key indent))
- (ent-alist (aget vhdl-entity-alist key t))
- (ent-entry (aget ent-alist token t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key t))
+ (ent-entry (vhdl-aget ent-alist token t))
(arch-alist (nth 3 ent-entry))
(inst-alist (vhdl-get-instantiations token indent))
(subpack-alist (nth 5 ent-entry))
@@ -14976,9 +15023,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add entity to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15017,11 +15064,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove entity from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15034,23 +15081,24 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand architecture
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key t))
+ (conf-alist (vhdl-aget vhdl-config-alist key t))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (car token) (cdr token) nil nil
0 (1- indent)))
- (ent-entry (aget ent-alist (car token) t))
- (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
+ (ent-entry (vhdl-aget ent-alist (car token) t))
+ (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token) t))
(subpack-alist (nth 4 arch-entry))
entry)
(if (not (or hier-alist subpack-alist))
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add architecture to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t))))
+ (vhdl-aput 'unit-alist (car token)
+ (list (cons (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15077,10 +15125,10 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove architecture from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t))))
+ (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15093,9 +15141,9 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand configuration
(let* ((key (vhdl-speedbar-line-key indent))
- (conf-alist (aget vhdl-config-alist key t))
- (conf-entry (aget conf-alist token))
- (ent-alist (aget vhdl-entity-alist key t))
+ (conf-alist (vhdl-aget vhdl-config-alist key t))
+ (conf-entry (vhdl-aget conf-alist token))
+ (ent-alist (vhdl-aget vhdl-entity-alist key t))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (nth 3 conf-entry)
(nth 4 conf-entry) token (nth 5 conf-entry)
@@ -15106,9 +15154,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add configuration to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15134,11 +15182,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove configuration from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15151,8 +15199,8 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand package
(let* ((key (vhdl-speedbar-line-key indent))
- (pack-alist (aget vhdl-package-alist key t))
- (pack-entry (aget pack-alist token t))
+ (pack-alist (vhdl-aget vhdl-package-alist key t))
+ (pack-entry (vhdl-aget pack-alist token t))
(comp-alist (nth 3 pack-entry))
(func-alist (nth 4 pack-entry))
(func-body-alist (nth 8 pack-entry))
@@ -15162,9 +15210,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add package to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15185,7 +15233,8 @@ otherwise use cached data."
(vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
(while func-alist
(setq func-entry (car func-alist)
- func-body-entry (aget func-body-alist (car func-entry) t))
+ func-body-entry (vhdl-aget func-body-alist
+ (car func-entry) t))
(when (nth 2 func-entry)
(vhdl-speedbar-make-subprogram-line
(nth 1 func-entry)
@@ -15203,11 +15252,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove package from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15217,15 +15266,15 @@ otherwise use cached data."
(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
"Insert required packages."
- (let* ((pack-alist (aget vhdl-package-alist
- (vhdl-speedbar-line-key dir-indent) t))
+ (let* ((pack-alist (vhdl-aget vhdl-package-alist
+ (vhdl-speedbar-line-key dir-indent) t))
pack-key lib-name pack-entry)
(when subpack-alist
(vhdl-speedbar-make-title-line "Packages Used:" indent))
(while subpack-alist
(setq pack-key (cdar subpack-alist)
lib-name (caar subpack-alist))
- (setq pack-entry (aget pack-alist pack-key t))
+ (setq pack-entry (vhdl-aget pack-alist pack-key t))
(vhdl-speedbar-make-subpack-line
(or (nth 0 pack-entry) pack-key) lib-name
(cons (nth 1 pack-entry) (nth 2 pack-entry))
@@ -15283,18 +15332,21 @@ NO-POSITION non-nil means do not re-position cursor."
(or always (not (equal file-name speedbar-last-selected-file))))
(if vhdl-speedbar-show-projects
(while project-list
- (setq file-alist (append file-alist (aget vhdl-file-alist
- (car project-list) t)))
+ (setq file-alist (append file-alist
+ (vhdl-aget vhdl-file-alist
+ (car project-list) t)))
(setq project-list (cdr project-list)))
- (setq file-alist (aget vhdl-file-alist
- (abbreviate-file-name default-directory) t)))
+ (setq file-alist
+ (vhdl-aget vhdl-file-alist
+ (abbreviate-file-name default-directory) t)))
(select-frame speedbar-frame)
(set-buffer speedbar-buffer)
(speedbar-with-writable
(vhdl-prepare-search-1
(save-excursion
;; unhighlight last units
- (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
+ (let* ((file-entry (vhdl-aget file-alist
+ speedbar-last-selected-file t)))
(vhdl-speedbar-update-units
"\\[.\\] " (nth 0 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-entity-face)
@@ -15314,7 +15366,7 @@ NO-POSITION non-nil means do not re-position cursor."
"> " (nth 6 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
;; highlight current units
- (let* ((file-entry (aget file-alist file-name t)))
+ (let* ((file-entry (vhdl-aget file-alist file-name t)))
(setq
pos (vhdl-speedbar-update-units
"\\[.\\] " (nth 0 file-entry)
@@ -15747,7 +15799,8 @@ is already shown in a buffer."
(let ((buffer (get-file-buffer (car token))))
(speedbar-find-file-in-frame (car token))
(when (or vhdl-speedbar-jump-to-unit buffer)
- (vhdl-goto-line (cdr token))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(recenter))
(vhdl-speedbar-update-current-unit t t)
(speedbar-set-timer dframe-update-speed)
@@ -15765,7 +15818,8 @@ is already shown in a buffer."
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (vhdl-goto-line (cdr token))
+ (progn (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(end-of-line)
(if is-entity
(vhdl-port-copy)
@@ -15805,9 +15859,11 @@ is already shown in a buffer."
(error "ERROR: No architecture under cursor")
(let* ((arch-key (downcase (vhdl-speedbar-line-text)))
(ent-key (downcase (vhdl-speedbar-higher-text)))
- (ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (ent-entry (aget ent-alist ent-key t)))
+ (ent-alist (vhdl-aget
+ vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory)) t))
+ (ent-entry (vhdl-aget ent-alist ent-key t)))
(setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
(speedbar-refresh))))
@@ -15946,15 +16002,14 @@ expansion function)."
;; add speedbar
(when (fboundp 'speedbar)
- (condition-case ()
- (when (and vhdl-speedbar-auto-open
- (not (and (boundp 'speedbar-frame)
- (frame-live-p speedbar-frame))))
- (speedbar-frame-mode 1)
- (if (fboundp 'speedbar-select-attached-frame)
- (speedbar-select-attached-frame)
- (select-frame speedbar-attached-frame)))
- (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))))
+ (let ((current-frame (selected-frame)))
+ (condition-case ()
+ (when (and vhdl-speedbar-auto-open
+ (not (and (boundp 'speedbar-frame)
+ (frame-live-p speedbar-frame))))
+ (speedbar-frame-mode 1))
+ (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))
+ (select-frame current-frame)))
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
@@ -16217,7 +16272,7 @@ component instantiation."
(setq constant-entry
(cons constant-name
(if (match-string 1)
- (or (aget generic-alist (match-string 2) t)
+ (or (vhdl-aget generic-alist (match-string 2) t)
(error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
(push constant-entry constant-alist)
@@ -16235,11 +16290,12 @@ component instantiation."
(vhdl-forward-syntactic-ws)
(while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
- (setq signal-entry (cons signal-name
- (if (match-string 1)
- (or (aget port-alist (match-string 2) t)
- (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
- (cdar port-alist))))
+ (setq signal-entry
+ (cons signal-name
+ (if (match-string 1)
+ (or (vhdl-aget port-alist (match-string 2) t)
+ (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
+ (cdar port-alist))))
(push signal-entry signal-alist)
(setq signal-name (downcase signal-name))
(if (equal (upcase (nth 2 signal-entry)) "IN")
@@ -16478,8 +16534,9 @@ current project/directory."
(pack-file-name
(concat (vhdl-replace-string vhdl-package-file-name pack-name t)
"." (file-name-extension (buffer-file-name))))
- (ent-alist (aget vhdl-entity-alist
- (or project default-directory) t))
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project
+ (abbreviate-file-name default-directory)) t))
(lazy-lock-minimum-size 0)
clause-pos component-pos)
(message "Generating components package \"%s\"..." pack-name)
@@ -16519,7 +16576,8 @@ current project/directory."
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (vhdl-goto-line (nth 3 (car ent-alist)))
+ (progn (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
(end-of-line)
(vhdl-port-copy)))
(goto-char component-pos)
@@ -16581,7 +16639,7 @@ current project/directory."
(when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
(setq conf-key (nth 0 (car tmp-alist))))
(setq tmp-alist (cdr tmp-alist)))
- (setq conf-entry (aget conf-alist conf-key t))
+ (setq conf-entry (vhdl-aget conf-alist conf-key t))
;; insert binding indication ...
;; ... with subconfiguration (if exists)
(if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
@@ -16591,7 +16649,7 @@ current project/directory."
(insert (vhdl-work-library) "." (nth 0 conf-entry))
(insert ";\n"))
;; ... with entity (if exists)
- (setq ent-entry (aget ent-alist (nth 5 inst-entry) t))
+ (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry) t))
(when ent-entry
(indent-to (+ margin vhdl-basic-offset))
(vhdl-insert-keyword "USE ENTITY ")
@@ -16601,9 +16659,9 @@ current project/directory."
(setq arch-name
;; choose architecture name a) from configuration,
;; b) from mra, or c) from first architecture
- (or (nth 0 (aget (nth 3 ent-entry)
- (or (nth 6 inst-entry)
- (nth 4 ent-entry)) t))
+ (or (nth 0 (vhdl-aget (nth 3 ent-entry)
+ (or (nth 6 inst-entry)
+ (nth 4 ent-entry)) t))
(nth 1 (car (nth 3 ent-entry)))))
(insert "(" arch-name ")"))
(insert ";\n")
@@ -16613,7 +16671,7 @@ current project/directory."
(indent-to (+ margin vhdl-basic-offset))
(vhdl-compose-configuration-architecture
(nth 0 ent-entry) arch-name ent-alist conf-alist
- (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
+ (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name) t))))))
;; insert component configuration end
(indent-to margin)
(vhdl-insert-keyword "END FOR;\n")
@@ -16635,10 +16693,12 @@ current project/directory."
"Generate configuration declaration."
(interactive)
(vhdl-require-hierarchy-info)
- (let ((ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (conf-alist (aget vhdl-config-alist
- (or (vhdl-project-p) default-directory) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory)) t))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory)) t))
(from-speedbar ent-name)
inst-alist conf-name conf-file-name pos)
(vhdl-prepare-search-2
@@ -16654,8 +16714,8 @@ current project/directory."
vhdl-compose-configuration-name
(concat ent-name " " arch-name)))
(setq inst-alist
- (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t))
- (downcase arch-name) t))))
+ (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name) t))
+ (downcase arch-name) t))))
(message "Generating configuration \"%s\"..." conf-name)
(if vhdl-compose-configuration-create-file
;; open configuration file
@@ -16721,8 +16781,8 @@ current project/directory."
(defun vhdl-makefile-name ()
"Return the Makefile name of the current project or the current compiler if
no project is defined."
- (let ((project-alist (aget vhdl-project-alist vhdl-project))
- (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
+ (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)"
(or (nth 8 project-alist) (nth 8 compiler-alist)))
@@ -16730,8 +16790,8 @@ no project is defined."
(defun vhdl-compile-directory ()
"Return the directory where compilation/make should be run."
- (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(directory (vhdl-resolve-env-variable
(if project
(vhdl-replace-string
@@ -16765,9 +16825,10 @@ no project is defined."
(defun vhdl-compile-init ()
"Initialize for compilation."
- (when (or (null compilation-error-regexp-alist)
- (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
- compilation-error-regexp-alist)))
+ (when (and (not vhdl-emacs-22)
+ (or (null compilation-error-regexp-alist)
+ (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
+ compilation-error-regexp-alist))))
;; `compilation-error-regexp-alist'
(let ((commands-alist vhdl-compiler-alist)
regexp-alist sublist)
@@ -16810,7 +16871,7 @@ do not print any file names."
&optional file-options-only)
"Get compiler options. Returning nil means do not compile this file."
(let* ((compiler-options (nth 1 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 0 project-entry))
(exception-list (and file-name (nth 2 project-entry)))
(work-library (vhdl-work-library))
@@ -16847,7 +16908,7 @@ do not print any file names."
(defun vhdl-get-make-options (project compiler)
"Get make options."
(let* ((compiler-options (nth 3 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 1 project-entry))
(makefile-name (vhdl-makefile-name)))
;; insert Makefile name in compiler-specific options
@@ -16868,8 +16929,8 @@ do not print any file names."
`vhdl-compiler'."
(interactive)
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler nil)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 0 compiler))
(default-directory (vhdl-compile-directory))
@@ -16910,8 +16971,8 @@ specified by a target."
(or target (read-from-minibuffer "Target: " vhdl-make-target
vhdl-minibuffer-local-map)))
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 2 compiler))
(options (vhdl-get-make-options project compiler))
@@ -16928,17 +16989,20 @@ specified by a target."
(let ((compiler-alist vhdl-compiler-alist)
(error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
(while compiler-alist
- ;; add error message regexps
- (setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
- (nth 11 (car compiler-alist)))
- error-regexp-alist))
- ;; add filename regexps
- (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ ;; only add regexps for currently selected compiler
+ (when (or (not vhdl-compile-use-local-error-regexp)
+ (equal vhdl-compiler (nth 0 (car compiler-alist))))
+ ;; add error message regexps
(setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
- (nth 12 (car compiler-alist)))
- error-regexp-alist)))
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
+ (nth 11 (car compiler-alist)))
+ error-regexp-alist))
+ ;; add filename regexps
+ (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ (setq error-regexp-alist
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
+ (nth 12 (car compiler-alist)))
+ error-regexp-alist))))
(setq compiler-alist (cdr compiler-alist)))
error-regexp-alist)
"List of regexps for VHDL compilers. For Emacs 22+.")
@@ -16949,6 +17013,10 @@ specified by a target."
(interactive)
(when (and (boundp 'compilation-error-regexp-alist-alist)
(not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
+ ;; remove all other compilers
+ (when vhdl-compile-use-local-error-regexp
+ (setq compilation-error-regexp-alist nil))
+ ;; add VHDL compilers
(mapcar
(lambda (item)
(push (car item) compilation-error-regexp-alist)
@@ -16964,7 +17032,7 @@ specified by a target."
(defun vhdl-generate-makefile ()
"Generate `Makefile'."
(interactive)
- (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 4 compiler)))
;; generate makefile
@@ -16997,15 +17065,19 @@ specified by a target."
(vhdl-scan-directory-contents directory))))
(let* ((directory (abbreviate-file-name (vhdl-default-directory)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project directory) t))
- (conf-alist (aget vhdl-config-alist (or project directory) t))
- (pack-alist (aget vhdl-package-alist (or project directory) t))
- (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
- (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
- (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
- (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
- (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
- (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
+ (ent-alist (vhdl-aget vhdl-entity-alist (or project directory) t))
+ (conf-alist (vhdl-aget vhdl-config-alist (or project directory) t))
+ (pack-alist (vhdl-aget vhdl-package-alist (or project directory) t))
+ (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
+ '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
+ "\\1.vhd" "\\1_body.vhd" identity)))
+ (mapping-exist
+ (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
+ (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
+ (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
+ (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
+ (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
+ (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
(adjust-case (nth 5 regexp-list))
(work-library (downcase (vhdl-work-library)))
(compile-directory (expand-file-name (vhdl-compile-directory)
@@ -17022,9 +17094,10 @@ specified by a target."
;; check prerequisites
(unless (file-exists-p compile-directory)
(make-directory compile-directory t))
- (unless regexp-list
- (error "Please contact the VHDL Mode maintainer for support of \"%s\""
- vhdl-compiler))
+ (unless mapping-exist
+ (vhdl-warning
+ (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\""
+ vhdl-compiler vhdl-compiler) t))
(message "Generating makefile \"%s\"..." makefile-name)
;; rules for all entities
(setq tmp-list ent-alist)
@@ -17038,13 +17111,15 @@ specified by a target."
compile-directory))
arch-alist (nth 4 ent-entry)
lib-alist (nth 6 ent-entry)
- rule (aget rule-alist ent-file-name)
+ rule (vhdl-aget rule-alist ent-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
second-list nil
subcomp-list nil)
(setq tmp-key (vhdl-replace-string
- ent-regexp (funcall adjust-case ent-key)))
+ ent-regexp
+ (funcall adjust-case
+ (concat ent-key " " work-library))))
(push (cons ent-key tmp-key) unit-list)
;; rule target for this entity
(push ent-key target-list)
@@ -17053,7 +17128,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist ent-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
;; rules for all corresponding architectures
(while arch-alist
(setq arch-entry (car arch-alist)
@@ -17065,12 +17140,14 @@ specified by a target."
compile-directory))
inst-alist (nth 4 arch-entry)
lib-alist (nth 5 arch-entry)
- rule (aget rule-alist arch-file-name)
+ rule (vhdl-aget rule-alist arch-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
arch-regexp
- (funcall adjust-case (concat arch-key " " ent-key))))
+ (funcall adjust-case
+ (concat arch-key " " ent-key " "
+ work-library))))
(setq unit-list
(cons (cons ent-arch-key tmp-key) unit-list))
(push ent-arch-key second-list)
@@ -17093,7 +17170,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist arch-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
(setq arch-alist (cdr arch-alist)))
(push (list ent-key second-list (append subcomp-list all-pack-list))
prim-list))
@@ -17112,12 +17189,14 @@ specified by a target."
arch-key (nth 5 conf-entry)
inst-alist (nth 6 conf-entry)
lib-alist (nth 7 conf-entry)
- rule (aget rule-alist conf-file-name)
+ rule (vhdl-aget rule-alist conf-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
subcomp-list (list ent-key))
(setq tmp-key (vhdl-replace-string
- conf-regexp (funcall adjust-case conf-key)))
+ conf-regexp
+ (funcall adjust-case
+ (concat conf-key " " work-library))))
(push (cons conf-key tmp-key) unit-list)
;; rule target for this configuration
(push conf-key target-list)
@@ -17131,20 +17210,17 @@ specified by a target."
(while inst-alist
(setq inst-entry (car inst-alist))
(setq inst-ent-key (nth 2 inst-entry)
-; comp-arch-key (nth 2 inst-entry))
inst-conf-key (nth 4 inst-entry))
(when (equal (downcase (nth 5 inst-entry)) work-library)
(when inst-ent-key
(setq depend-list (cons inst-ent-key depend-list)
subcomp-list (cons inst-ent-key subcomp-list)))
-; (when comp-arch-key
-; (push (concat comp-ent-key "-" comp-arch-key) depend-list))
(when inst-conf-key
(setq depend-list (cons inst-conf-key depend-list)
subcomp-list (cons inst-conf-key subcomp-list))))
(setq inst-alist (cdr inst-alist)))
;; add rule
- (aput 'rule-alist conf-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
(push (list conf-key nil (append subcomp-list pack-list)) prim-list)
(setq conf-alist (cdr conf-alist)))
(setq conf-alist tmp-list)
@@ -17160,10 +17236,12 @@ specified by a target."
(file-relative-name (nth 2 pack-entry)
compile-directory))
lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
- rule (aget rule-alist pack-file-name)
+ rule (vhdl-aget rule-alist pack-file-name)
target-list (nth 0 rule) depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-regexp (funcall adjust-case pack-key)))
+ pack-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(push (cons pack-key tmp-key) unit-list)
;; rule target for this package
(push pack-key target-list)
@@ -17172,7 +17250,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist pack-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
;; rules for this package's body
(when (nth 7 pack-entry)
(setq pack-body-key (concat pack-key "-body")
@@ -17180,11 +17258,13 @@ specified by a target."
(nth 7 pack-entry)
(file-relative-name (nth 7 pack-entry)
compile-directory))
- rule (aget rule-alist pack-body-file-name)
+ rule (vhdl-aget rule-alist pack-body-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-body-regexp (funcall adjust-case pack-key)))
+ pack-body-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(setq unit-list
(cons (cons pack-body-key tmp-key) unit-list))
;; rule target for this package's body
@@ -17196,8 +17276,8 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist pack-body-file-name
- (list target-list depend-list)))
+ (vhdl-aput 'rule-alist pack-body-file-name
+ (list target-list depend-list)))
(setq prim-list
(cons (list pack-key (when pack-body-key (list pack-body-key))
all-pack-list)
@@ -17205,8 +17285,8 @@ specified by a target."
(setq pack-alist (cdr pack-alist)))
(setq pack-alist tmp-list)
;; generate Makefile
- (let* ((project (aget vhdl-project-alist project))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist project))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(compiler-id (nth 9 compiler))
(library-directory
(vhdl-resolve-env-variable
@@ -17259,12 +17339,16 @@ specified by a target."
compile-directory))))
(insert "\n\n# Define library paths\n"
"\nLIBRARY-" work-library " = " library-directory "\n")
+ (unless mapping-exist
+ (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
+ ")/make" "\n"))
;; insert variable definitions for all library unit files
(insert "\n\n# Define library unit files\n")
(setq tmp-list unit-list)
(while unit-list
(insert "\nUNIT-" work-library "-" (caar unit-list)
- " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
+ " = \\\n\t$(LIBRARY-" work-library
+ (if mapping-exist "" "-make") ")/" (cdar unit-list))
(setq unit-list (cdr unit-list)))
;; insert variable definition for list of all library unit files
(insert "\n\n\n# Define list of all library unit files\n"
@@ -17287,13 +17371,20 @@ specified by a target."
;; insert `make library' rule
(insert "\n\n# Rule for creating library directory\n"
"\n" (nth 2 vhdl-makefile-default-targets) " :"
- " \\\n\t\t$(LIBRARY-" work-library ")\n"
+ " \\\n\t\t$(LIBRARY-" work-library ")"
+ (if mapping-exist ""
+ (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
+ "\n"
"\n$(LIBRARY-" work-library ") :"
"\n\t"
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
(concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
"\n")
+ (unless mapping-exist
+ (insert "\n$(LIBRARY-" work-library "-make) :"
+ "\n\t"
+ "mkdir -p $(LIBRARY-" work-library "-make)\n"))
;; insert '.PHONY' declaration
(insert "\n\n.PHONY : "
(nth 0 vhdl-makefile-default-targets) " "
@@ -17306,9 +17397,9 @@ specified by a target."
(setq subcomp-list
(sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
(setq unit-key (caar prim-list)
- unit-name (or (nth 0 (aget ent-alist unit-key t))
- (nth 0 (aget conf-alist unit-key t))
- (nth 0 (aget pack-alist unit-key t))))
+ unit-name (or (nth 0 (vhdl-aget ent-alist unit-key t))
+ (nth 0 (vhdl-aget conf-alist unit-key t))
+ (nth 0 (vhdl-aget pack-alist unit-key t))))
(insert "\n" unit-key)
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
@@ -17358,13 +17449,15 @@ specified by a target."
(nth 0 rule)
(if (equal vhdl-compile-post-command "") ""
" $(POST-COMPILE)") "\n")
+ (insert "\n"))
+ (unless (and options mapping-exist)
(setq tmp-list target-list)
(while target-list
- (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
- (if (cdr target-list) " \\" "\n"))
+ (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
(setq target-list (cdr target-list)))
(setq target-list tmp-list))
(setq rule-alist (cdr rule-alist)))
+
(insert "\n\n### " makefile-name " ends here\n")
;; run Makefile generation hook
(run-hooks 'vhdl-makefile-generation-hook)
@@ -17374,7 +17467,8 @@ specified by a target."
(progn (save-buffer)
(kill-buffer (current-buffer))
(set-buffer orig-buffer)
- (add-to-history 'file-name-history makefile-path-name))
+ (when (fboundp 'add-to-history)
+ (add-to-history 'file-name-history makefile-path-name)))
(vhdl-warning-when-idle
(format "File not writable: \"%s\""
(abbreviate-file-name makefile-path-name)))
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index e22581445e5..4ab882b71fb 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,4 +1,4 @@
-;;; xscheme.el --- run MIT Scheme under Emacs
+;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986-1987, 1989-1990, 2001-2014 Free Software
;; Foundation, Inc.
@@ -49,13 +49,13 @@
(defvar xscheme-expressions-ring-max 30
"Maximum length of Scheme expressions ring.")
-(defvar xscheme-expressions-ring nil
+(defvar-local xscheme-expressions-ring nil
"List of expressions recently transmitted to the Scheme process.")
-(defvar xscheme-expressions-ring-yank-pointer nil
+(defvar-local xscheme-expressions-ring-yank-pointer nil
"The tail of the Scheme expressions ring whose car is the last thing yanked.")
-(defvar xscheme-running-p nil
+(defvar-local xscheme-running-p nil
"This variable, if nil, indicates that the scheme process is
waiting for input. Otherwise, it is busy evaluating something.")
@@ -64,7 +64,7 @@ waiting for input. Otherwise, it is busy evaluating something.")
control-g interrupts were signaled. Do not allow more control-g's to be
signaled until the scheme process acknowledges receipt.")
-(defvar xscheme-control-g-disabled-p nil
+(defvar-local xscheme-control-g-disabled-p nil
"This variable, if non-nil, indicates that a control-g is being processed
by the scheme process, so additional control-g's are to be ignored.")
@@ -78,37 +78,26 @@ by the scheme process, so additional control-g's are to be ignored.")
(defvar xscheme-runlight "")
(defvar xscheme-runlight-string nil)
-(defvar xscheme-process-filter-state 'idle
+(defvar-local xscheme-process-filter-state 'idle
"State of scheme process escape reader state machine:
idle waiting for an escape sequence
reading-type received an altmode but nothing else
reading-string reading prompt string")
-(defvar xscheme-allow-output-p t
+(defvar-local xscheme-allow-output-p t
"This variable, if nil, prevents output from the scheme process
from being inserted into the process-buffer.")
-(defvar xscheme-prompt ""
+(defvar-local xscheme-prompt ""
"The current scheme prompt string.")
-(defvar xscheme-string-accumulator ""
+(defvar-local xscheme-string-accumulator ""
"Accumulator for the string being received from the scheme process.")
-(defvar xscheme-mode-string nil)
-(setq-default scheme-mode-line-process
- '("" xscheme-runlight))
-
-(mapc 'make-variable-buffer-local
- '(xscheme-expressions-ring
- xscheme-expressions-ring-yank-pointer
- xscheme-process-filter-state
- xscheme-running-p
- xscheme-control-g-disabled-p
- xscheme-allow-output-p
- xscheme-prompt
- xscheme-string-accumulator
- xscheme-mode-string
- scheme-mode-line-process))
+(defvar-local xscheme-mode-string nil)
+(setq-default scheme-mode-line-process '("" xscheme-runlight))
+(make-variable-buffer-local 'scheme-mode-line-process)
+
(defgroup xscheme nil
"Major mode for editing Scheme and interacting with MIT's C-Scheme."
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-27 15:00:11 +0000