commit 0db2126d7176b0bd1b13d4b0d1cd958c8cf55714 (HEAD, refs/remotes/origin/master) Author: Dmitry Gutov Date: Sat Apr 10 01:51:39 2021 +0300 Don't stop when before space or closing paren * lisp/progmodes/elisp-mode.el (elisp-completion-at-point): Don't stop when before space or closing paren (bug#47665). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8ade718640..203712f45d 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -496,7 +496,7 @@ functions are annotated with \"\" via the (end (unless (or (eq beg (point-max)) (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) + '(?\" ?\())) (condition-case nil (save-excursion (goto-char beg) commit f493a9bef46dc48f7282e296996186d6d8f77684 Author: Alan Mackenzie Date: Fri Apr 9 20:52:49 2021 +0000 CC Mode: fix c-where-wrt-brace-construct to cope with class declarations Make the function correctly recognize a brace block preceded by an introductory line without a parameter list. * lisp/progmodes/cc-cmds.el (c-where-wrt-brace-contruct): Reintroduce the use of c-beginning-of-decl-1, which was removed some weeks ago, in place of a c-syntactic-skip-backward. Reformulate the code generally. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 1754436d13..c894944827 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1639,7 +1639,8 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (knr-start knr-res + (let* (kluge-start + knr-start knr-res decl-result brace-decl-p (start (point)) (paren-state (c-parse-state)) @@ -1670,12 +1671,20 @@ No indentation or other \"electric\" behavior is performed." (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t + ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already + ;; at a declaration. + (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" + (not (c-looking-at-non-alphnumspace))) + (forward-char)) + (setq kluge-start (point)) + (if (and least-enclosing (eq (char-after least-enclosing) ?\()) (c-go-list-forward least-enclosing)) (c-forward-syntactic-ws) (setq knr-start (point)) - (if (c-syntactic-re-search-forward "{" nil t t) + (if (and (c-syntactic-re-search-forward "[;{]" nil t t) + (eq (char-before) ?\{)) (progn (backward-char) (cond @@ -1689,19 +1698,27 @@ No indentation or other \"electric\" behavior is performed." ((and knr-res (goto-char knr-res) (c-backward-syntactic-ws))) ; Always returns nil. - ((and (eq (char-before) ?\)) - (c-go-list-backward)) - (c-syntactic-skip-backward "^;" start t) - (if (eq (point) start) - (if (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\; ?} nil))) - (if (progn (c-forward-syntactic-ws) - (eq (point) start)) - 'at-header - 'outwith-function) - 'in-header) - 'outwith-function)) - (t 'outwith-function))) + (t + (when (eq (char-before) ?\)) + ;; The `c-go-list-backward' is a precaution against + ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda + ;; function inside the parentheses. + (c-go-list-backward)) + (setq decl-result + (car (c-beginning-of-decl-1 + (and least-enclosing + (c-safe-position + least-enclosing paren-state))))) + (cond + ((> (point) start) + 'outwith-function) + ((eq decl-result 'same) + (if (eq (point) start) + 'at-header + 'in-header)) + (t (error + "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s" + decl-result)))))) 'outwith-function)))))) (defun c-backward-to-nth-BOF-{ (n where) commit 59342f689eaa4839b0fc15351ae48b4f1074a6fc Author: Mattias Engdegård Date: Fri Apr 9 18:59:09 2021 +0200 Fix condition-case optimiser bug * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't perform incorrect optimisations when a condition-case variable shadows another lexical variable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): New test case. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index db8d825cfe..e526537531 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) + (let ((byte-optimize--lexvars + (and lexical-binding + (if var + (cons (list var t) + byte-optimize--lexvars) + byte-optimize--lexvars)))) + (cons (car clause) + (byte-optimize-body (cdr clause) for-effect)))) clauses)))) (`(unwind-protect ,exp . ,exps) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 1953878d6f..94e33a7770 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -431,6 +431,12 @@ (let ((x 2)) (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + + (let* ((x 1) + (y (condition-case x + (/ 1 0) + (arith-error x)))) + (list x y)) ) "List of expressions for cross-testing interpreted and compiled code.") commit b7a7e879d02570cbf74aa87686b6b0ed4e6b0c3b Author: Mattias Engdegård Date: Fri Apr 9 18:49:16 2021 +0200 Better compiler warning tests These changes allow all bytecomp-tests to be run interactively. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test) (bytecomp--define-warning-file-test): Interpret any space in the pattern as arbitrary whitespace to tolerate line breaks. Don't abuse the expected-failure mechanism when checking for the expected absense of a warning. (bytecomp/*.el): Rewrite patterns to work with line breaks in the middle. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index b1377e59f7..1953878d6f 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -569,8 +569,8 @@ byte-compiled. Run with dynamic binding." `(with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile ,@form) - (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning))))) + (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") + (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) (ert-deftest bytecomp-warn-wrong-args () (bytecomp--with-warning-test "remq.*3.*2" @@ -596,12 +596,13 @@ byte-compiled. Run with dynamic binding." (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () - :expected-result ,(if reverse :failed :passed) (with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile-file ,(ert-resource-file file)) (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning)))))) + (,(if reverse 'should-not 'should) + (re-search-forward ,(string-replace " " "[ \n]+" re-warning) + nil t)))))) (bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" "add-hook.*lexical var") @@ -643,10 +644,10 @@ byte-compiled. Run with dynamic binding." "free.*foo") (bytecomp--define-warning-file-test "warn-free-variable-reference.el" - "free.*bar") + "free variable .bar") (bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el" - "make-variable-buffer-local.*not called at toplevel") + "make-variable-buffer-local. not called at toplevel") (bytecomp--define-warning-file-test "warn-interactive-only.el" "next-line.*interactive use only.*forward-line") @@ -655,19 +656,19 @@ byte-compiled. Run with dynamic binding." "malformed interactive spec") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" - "foo-obsolete.*obsolete function.*99.99") + "foo-obsolete. is an obsolete function (as of 99.99)") (defvar bytecomp--tests-obsolete-var nil) (make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99") (bytecomp--define-warning-file-test "warn-obsolete-hook.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el" "foo-obs.*obsolete.*99.99" t) (bytecomp--define-warning-file-test "warn-obsolete-variable.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" "bytecomp--tests-obs.*obsolete.*99.99" t) @@ -698,64 +699,64 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-wide-docstring-autoload.el" - "autoload.*foox.*wider than.*characters") + "autoload .foox. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-custom-declare-variable.el" - "custom-declare-variable.*foo.*wider than.*characters") + "custom-declare-variable .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defalias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defconst.el" - "defconst.*foo.*wider than.*characters") + "defconst .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-abbrev-table.el" - "define-abbrev.*foo.*wider than.*characters") + "define-abbrev-table .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-function-alias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-variable-alias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo. docstring wider than .* characters") ;; TODO: We don't yet issue warnings for defuns. (bytecomp--define-warning-file-test "warn-wide-docstring-defun.el" - "wider than.*characters" 'reverse) + "wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-defvar.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defvaralias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-fill-column.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-override.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-multiline-first.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-multiline.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "nowarn-inline-after-defvar.el" commit a2a7cfde29aa71f9ea503b8dc467d694f6e5b69f Author: Mattias Engdegård Date: Fri Apr 9 18:42:12 2021 +0200 Clean up bytecomp-tests.el Now all test cases are run with both lexical and dynamic binding where applicable, comparing interpreted against compiled results. Previously, almost all tests were only run with dynamic binding which was definitely not intended. * test/lisp/emacs-lisp/bytecomp-tests.el (byte-opt-testsuite-arith-data): Rename to bytecomp-tests--test-cases. (bytecomp-check-1, bytecomp-explain-1, bytecomp-tests) (bytecomp-lexbind-tests, bytecomp-lexbind-check-1) (bytecomp-lexbind-explain-1): Remove. (bytecomp-tests--eval-interpreted, bytecomp-tests--eval-compiled) (bytecomp-tests-lexbind, bytecomp-tests-dynbind) (bytecomp-tests--test-cases-lexbind-only): New. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 0f7a0ccc85..b1377e59f7 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -41,7 +41,7 @@ "Identity, but hidden from some optimisations." x) -(defconst byte-opt-testsuite-arith-data +(defconst bytecomp-tests--test-cases '( ;; some functional tests (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) @@ -430,69 +430,54 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-test-identity 'a) (setq x 3)) x))) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") + (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + ) + "List of expressions for cross-testing interpreted and compiled code.") -(defun bytecomp-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) - -(defun bytecomp-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-tests () - "Test the Emacs byte compiler." - (dolist (pat byte-opt-testsuite-arith-data) - (should (bytecomp-check-1 pat)))) - -(defun test-byte-opt-arithmetic (&optional arg) - "Unit test for byte-opt arithmetic operations. -Subtests signal errors if something goes wrong." - (interactive "P") - (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) +(defconst bytecomp-tests--test-cases-lexbind-only + `( + ;; This would infloop (and exhaust stack) with dynamic binding. + (let ((f #'car)) + (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) + (funcall f '(1 . 2)))) + ) + "List of expressions for cross-testing interpreted and compiled code. +These are only tested with lexical binding.") + +(defun bytecomp-tests--eval-interpreted (form) + "Evaluate FORM using the Lisp interpreter, returning errors as a +special value." + (condition-case err + (eval form lexical-binding) + (error (list 'bytecomp-check-error (car err))))) + +(defun bytecomp-tests--eval-compiled (form) + "Evaluate FORM using the Lisp byte-code compiler, returning errors as a +special value." (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (pass-face '((t :foreground "green"))) - (fail-face '((t :foreground "red"))) - (print-escape-nonascii t) - (print-escape-newlines t) - (print-quoted t) - v0 v1) - (dolist (pat byte-opt-testsuite-arith-data) - (condition-case err - (setq v0 (eval pat)) - (error (setq v0 (list 'bytecomp-check-error (car err))))) - (condition-case err - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 (list 'bytecomp-check-error (car err))))) - (insert (format "%s" pat)) - (indent-to-column 65) - (if (equal v0 v1) - (insert (propertize "OK" 'face pass-face)) - (insert (propertize "FAIL\n" 'face fail-face)) - (indent-to-column 55) - (insert (propertize (format "[%s] vs [%s]" v0 v1) - 'face fail-face))) - (insert "\n")))) + (byte-compile-warnings nil)) + (condition-case err + (funcall (byte-compile (list 'lambda nil form))) + (error (list 'bytecomp-check-error (car err)))))) + +(ert-deftest bytecomp-tests-lexbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with lexical binding." + (let ((lexical-binding t)) + (dolist (form (append bytecomp-tests--test-cases-lexbind-only + bytecomp-tests--test-cases)) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) + +(ert-deftest bytecomp-tests-dynbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with dynamic binding." + (let ((lexical-binding nil)) + (dolist (form bytecomp-tests--test-cases) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) (defun test-byte-comp-compile-and-load (compile &rest forms) (declare (indent 1)) @@ -813,47 +798,6 @@ Subtests signal errors if something goes wrong." (defun def () (m)))) (should (equal (funcall 'def) 4))) -(defconst bytecomp-lexbind-tests - `( - (let ((f #'car)) - (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) - (funcall f '(1 . 2)))) - ) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") - -(defun bytecomp-lexbind-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) - -(defun bytecomp-lexbind-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-lexbind-tests () - "Test the Emacs byte compiler lexbind handling." - (dolist (pat bytecomp-lexbind-tests) - (should (bytecomp-lexbind-check-1 pat)))) - (defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) (declare (indent 1)) (cl-check-type file-name-var symbol) commit 40db60563c6b259e1208b6931f0a343849026814 Author: Stefan Kangas Date: Fri Apr 9 18:42:14 2021 +0200 Make refer-every into obsolete alias for seq-every-p * lisp/textmodes/refer.el (refer-every): Make into obsolete function alias for seq-every-p. Update single caller. diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 53519ac338..e710180d5f 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -245,10 +245,10 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (forward-paragraph 1) (setq end (point)) (setq found - (refer-every (lambda (keyword) - (goto-char begin) - (re-search-forward keyword end t)) - keywords-list)) + (seq-every-p (lambda (keyword) + (goto-char begin) + (re-search-forward keyword end t)) + keywords-list)) (if (not found) (progn (setq begin end) @@ -260,12 +260,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (progn (message "Scanning %s... not found" file) nil)))) -(defun refer-every (pred l) - (cond ((null l) nil) - ((funcall pred (car l)) - (or (null (cdr l)) - (refer-every pred (cdr l)))))) - (defun refer-convert-string-to-list-of-strings (s) (let ((current (current-buffer)) (temp-buffer (get-buffer-create "*refer-temp*"))) @@ -391,4 +385,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (setq refer-bib-files files)) files)) +(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1") + ;;; refer.el ends here commit 512ec97bcf5aaaf0696f2e816ff764324bb67185 Author: Stefan Kangas Date: Fri Apr 9 00:14:12 2021 +0200 Remove redundant #' before lambda in ibuf-*.el * lisp/ibuf-ext.el (ibuffer-included-in-filters-p) (ibuffer-included-in-filter-p-1, ibuffer-do-kill-lines) (ibuffer-jump-to-buffer, ibuffer-mark-on-buffer) (ibuffer-mark-by-name-regexp, ibuffer-mark-by-mode-regexp) (ibuffer-mark-by-content-regexp, ibuffer-mark-by-mode) (ibuffer-mark-modified-buffers, ibuffer-mark-unsaved-buffers) (ibuffer-mark-dissociated-buffers, ibuffer-mark-help-buffers) (ibuffer-mark-compressed-file-buffers, ibuffer-mark-old-buffers) (ibuffer-mark-special-buffers, ibuffer-mark-read-only-buffers) (ibuffer-mark-dired-buffers, ibuffer-do-occur): * lisp/ibuf-macs.el (ibuffer-save-marks, define-ibuffer-sorter) (define-ibuffer-op): Remove redundant #' before lambda. diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 44574abd46..48f9e8a990 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -687,8 +687,8 @@ specifications with the same structure as `ibuffer-filtering-qualifiers'." (not (memq nil ;; a filter will return nil if it failed - (mapcar #'(lambda (filter) - (ibuffer-included-in-filter-p buf filter)) + (mapcar (lambda (filter) + (ibuffer-included-in-filter-p buf filter)) filters)))) (defun ibuffer-unary-operand (filter) @@ -724,8 +724,8 @@ specification, with the same structure as an element of the list ;; (dolist (filter-spec (cdr filter) nil) ;; (when (ibuffer-included-in-filter-p buf filter-spec) ;; (throw 'has-match t)))) - (memq t (mapcar #'(lambda (x) - (ibuffer-included-in-filter-p buf x)) + (memq t (mapcar (lambda (x) + (ibuffer-included-in-filter-p buf x)) (cdr filter)))) ('and (catch 'no-match @@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'." (message "No buffers marked; use `m' to mark a buffer") (let ((count (ibuffer-map-marked-lines - #'(lambda (_buf _mark) - 'kill)))) + (lambda (_buf _mark) + 'kill)))) (message "Killed %s lines" count)))) ;;;###autoload @@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable." (when current-prefix-arg (setq only-visible (not only-visible))) (if only-visible - (let ((table (mapcar #'(lambda (x) - (buffer-name (car x))) + (let ((table (mapcar (lambda (x) + (buffer-name (car x))) (ibuffer-current-state-list)))) (when (null table) (error "No buffers!")) @@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that variable." (let (buf-point) ;; Blindly search for our buffer: it is very likely that it is ;; not in a hidden filter group. - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t nil) (when (and (null buf-point) @@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that variable." (dolist (group ibuffer-hidden-filter-groups) (ibuffer-jump-to-filter-group group) (ibuffer-toggle-filter-group) - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t group) (if buf-point (throw 'found nil) @@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands with \\[yank]." (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) (let ((count (ibuffer-map-lines - #'(lambda (buf _mark) - (when (funcall func buf) - (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark - ibuffer-marked-char)) - t)) + (lambda (buf _mark) + (when (funcall func buf) + (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark + ibuffer-marked-char)) + t)) nil group))) (ibuffer-redisplay t) @@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with \\[yank]." "Mark all buffers whose name matches REGEXP." (interactive "sMark by name (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (string-match regexp (buffer-name buf))))) + (lambda (buf) + (string-match regexp (buffer-name buf))))) (defun ibuffer-locked-buffer-p (&optional buf) "Return non-nil if BUF is locked. @@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line." "Mark all buffers whose major mode matches REGEXP." (interactive "sMark by major mode (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (string-match regexp (format-mode-line mode-name nil nil buf)))))) + (lambda (buf) + (with-current-buffer buf + (string-match regexp (format-mode-line mode-name nil nil buf)))))) ;;;###autoload (defun ibuffer-mark-by-file-name-regexp (regexp) @@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of (interactive (let ((reg (read-string "Mark by content (regexp): "))) (list reg current-prefix-arg))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (let ((mode (with-current-buffer buf major-mode)) - res) - (cond ((and (not all-buffers) - (or - (memq mode ibuffer-never-search-content-mode) - (cl-dolist (x ibuffer-never-search-content-name nil) - (when-let ((found (string-match x (buffer-name buf)))) - (cl-return found))))) - (setq res nil)) - (t - (with-current-buffer buf - (save-mark-and-excursion - (goto-char (point-min)) - (setq res (re-search-forward regexp nil t)))))) res)))) + (lambda (buf) + (let ((mode (with-current-buffer buf major-mode)) + res) + (cond ((and (not all-buffers) + (or + (memq mode ibuffer-never-search-content-mode) + (cl-dolist (x ibuffer-never-search-content-name nil) + (when-let ((found (string-match x (buffer-name buf)))) + (cl-return found))))) + (setq res nil)) + (t + (with-current-buffer buf + (save-mark-and-excursion + (goto-char (point-min)) + (setq res (re-search-forward regexp nil t)))))) res)))) ;;;###autoload (defun ibuffer-mark-by-mode (mode) @@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of (format-prompt "Mark by major mode" default) (ibuffer-list-buffer-modes) nil t nil nil default))))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (eq (buffer-local-value 'major-mode buf) mode)))) + (lambda (buf) + (eq (buffer-local-value 'major-mode buf) mode)))) ;;;###autoload (defun ibuffer-mark-modified-buffers () "Mark all modified buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-modified-p buf)))) + (lambda (buf) (buffer-modified-p buf)))) ;;;###autoload (defun ibuffer-mark-unsaved-buffers () "Mark all modified buffers that have an associated file." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf) - (buffer-modified-p buf))))) + (lambda (buf) (and (buffer-local-value 'buffer-file-name buf) + (buffer-modified-p buf))))) ;;;###autoload (defun ibuffer-mark-dissociated-buffers () "Mark all buffers whose associated file does not exist." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (or - (and buffer-file-name - (not (file-exists-p buffer-file-name))) - (and (eq major-mode 'dired-mode) - (boundp 'dired-directory) - (stringp dired-directory) - (not (file-exists-p (file-name-directory dired-directory))))))))) + (lambda (buf) + (with-current-buffer buf + (or + (and buffer-file-name + (not (file-exists-p buffer-file-name))) + (and (eq major-mode 'dired-mode) + (boundp 'dired-directory) + (stringp dired-directory) + (not (file-exists-p (file-name-directory dired-directory))))))))) ;;;###autoload (defun ibuffer-mark-help-buffers () "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (memq major-mode ibuffer-help-buffer-modes))))) + (lambda (buf) + (with-current-buffer buf + (memq major-mode ibuffer-help-buffer-modes))))) ;;;###autoload (defun ibuffer-mark-compressed-file-buffers () "Mark buffers whose associated file is compressed." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (and buffer-file-name - (string-match ibuffer-compressed-file-name-regexp - buffer-file-name)))))) + (lambda (buf) + (with-current-buffer buf + (and buffer-file-name + (string-match ibuffer-compressed-file-name-regexp + buffer-file-name)))))) ;;;###autoload (defun ibuffer-mark-old-buffers () "Mark buffers which have not been viewed in `ibuffer-old-time' hours." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (when buffer-display-time - (time-less-p - (* 60 60 ibuffer-old-time) - (time-since buffer-display-time))))))) + (lambda (buf) + (with-current-buffer buf + (when buffer-display-time + (time-less-p + (* 60 60 ibuffer-old-time) + (time-since buffer-display-time))))))) ;;;###autoload (defun ibuffer-mark-special-buffers () "Mark all buffers whose name begins and ends with `*'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (string-match "^\\*.+\\*$" - (buffer-name buf))))) + (lambda (buf) (string-match "^\\*.+\\*$" + (buffer-name buf))))) ;;;###autoload (defun ibuffer-mark-read-only-buffers () "Mark all read-only buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-local-value 'buffer-read-only buf)))) + (lambda (buf) (buffer-local-value 'buffer-read-only buf)))) ;;;###autoload (defun ibuffer-mark-dired-buffers () "Mark all `dired' buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) + (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) ;;;###autoload (defun ibuffer-do-occur (regexp &optional nlines) @@ -1970,8 +1970,8 @@ defaults to one." (let ((ibuffer-do-occur-bufs nil)) ;; Accumulate a list of marked buffers (ibuffer-map-marked-lines - #'(lambda (buf _mark) - (push buf ibuffer-do-occur-bufs))) + (lambda (buf _mark) + (push buf ibuffer-do-occur-bufs))) (occur-1 regexp nlines ibuffer-do-occur-bufs))) (provide 'ibuf-ext) diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index be09c6582c..fcc4f9e751 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST." (ibuffer-redisplay-engine ;; Get rid of dead buffers (delq nil - (mapcar #'(lambda (e) (when (buffer-live-p (car e)) - e)) + (mapcar (lambda (e) (when (buffer-live-p (car e)) + e)) ibuffer-save-marks-tmp-mark-list))) (ibuffer-redisplay t)))))) @@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'. (ibuffer-redisplay t) (setq ibuffer-last-sorting-mode ',name)) (push (list ',name ,description - #'(lambda (a b) - ,@body)) + (lambda (a b) + ,@body)) ibuffer-sorting-functions-alist) :autoload-end)) @@ -259,18 +259,18 @@ buffer object. 'ibuffer-map-deletion-lines) (_ 'ibuffer-map-marked-lines)) - #'(lambda (buf mark) - ;; Silence warning for code that doesn't - ;; use `mark'. - (ignore mark) - ,(if (eq modifier-p :maybe) - `(let ((ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (prog1 ,inner-body - (when (not (eq ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (setq ibuffer-did-modification t)))) - inner-body))))) + (lambda (buf mark) + ;; Silence warning for code that doesn't + ;; use `mark'. + (ignore mark) + ,(if (eq modifier-p :maybe) + `(let ((ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (prog1 ,inner-body + (when (not (eq ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (setq ibuffer-did-modification t)))) + inner-body))))) ,finish))) (if dangerous `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) commit cdd72c5d89cb9920f7cd36dfd08429d29ce8e881 Author: Stefan Kangas Date: Fri Apr 9 18:25:08 2021 +0200 Don't preserve window-line in tabulated-list-print * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print): Don't try to preserve window-line. (Bug#42747) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0c299b48b9..0b10dfdc0a 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -410,8 +410,7 @@ specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. Optional argument REMEMBER-POS, if non-nil, means to move point -to the entry with the same ID element as the current line and -recenter window line accordingly. +to the entry with the same ID element as the current line. Non-nil UPDATE argument means to use an alternative printing method which is faster if most entries haven't changed since the @@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'." (funcall tabulated-list-entries) tabulated-list-entries)) (sorter (tabulated-list--get-sorter)) - entry-id saved-pt saved-col window-line) + entry-id saved-pt saved-col) (and remember-pos (setq entry-id (tabulated-list-get-id)) - (setq saved-col (current-column)) - (when (eq (window-buffer) (current-buffer)) - (setq window-line - (save-excursion - (save-restriction - (widen) - (narrow-to-region (window-start) (point)) - (goto-char (point-min)) - (vertical-motion (buffer-size))))))) + (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter (setq entries (sort entries sorter))) @@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'." ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt (progn (goto-char saved-pt) - (move-to-column saved-col) - (when window-line - (recenter window-line))) + (move-to-column saved-col)) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) commit 22515134ae83b625964f7719e172435f016be0f2 Author: Stefan Kangas Date: Fri Apr 9 16:16:42 2021 +0200 Use lexical-binding in winner.el * lisp/winner.el: Use lexical-binding. Remove redundant :group args. (winner-set, winner-mode-map): Quote function symbols as such. diff --git a/lisp/winner.el b/lisp/winner.el index 9506ac53bb..f30fa6cf5c 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,4 +1,4 @@ -;;; winner.el --- Restore old window configurations +;;; winner.el --- Restore old window configurations -*- lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. @@ -33,14 +33,13 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'ring) (defun winner-active-region () (declare (gv-setter (lambda (store) `(if ,store (activate-mark) (deactivate-mark))))) (region-active-p)) -(require 'ring) - (defgroup winner nil "Restoring window configurations." :group 'windows) @@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*, *Apropos*, (let* ((buffers nil) (alive ;; Possibly update `winner-point-alist' - (cl-loop for buf in (mapcar 'cdr (cdr conf)) + (cl-loop for buf in (mapcar #'cdr (cdr conf)) for pos = (winner-get-point buf nil) if (and pos (not (memq buf buffers))) do (push buf buffers) @@ -317,7 +316,7 @@ You may want to include buffer names such as *Help*, *Apropos*, ;; Return t if this is still a possible configuration. (or (null xwins) (progn - (mapc 'delete-window (cdr xwins)) ; delete all but one + (mapc #'delete-window (cdr xwins)) ; delete all but one (unless (one-window-p t) (delete-window (car xwins)) t)))))) @@ -328,22 +327,20 @@ You may want to include buffer names such as *Help*, *Apropos*, (defcustom winner-mode-hook nil "Functions to run whenever Winner mode is turned on or off." - :type 'hook - :group 'winner) + :type 'hook) (define-obsolete-variable-alias 'winner-mode-leave-hook 'winner-mode-off-hook "24.3") (defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." - :type 'hook - :group 'winner) + :type 'hook) (defvar winner-mode-map (let ((map (make-sparse-keymap))) (unless winner-dont-bind-my-keys - (define-key map [(control c) left] 'winner-undo) - (define-key map [(control c) right] 'winner-redo)) + (define-key map [(control c) left] #'winner-undo) + (define-key map [(control c) right] #'winner-redo)) map) "Keymap for Winner mode.") commit e7ee3f733062e50011d91ddb2a31de80ba7eaf58 Merge: fb596973b9 5b1e7af7bf Author: Stefan Monnier Date: Fri Apr 9 10:26:42 2021 -0400 Merge branch 'vhdl-mode-lexbind' into trunk commit fb596973b96408dc2fbdb5cfd4e16e818af27fbb Author: Stefan Kangas Date: Fri Apr 9 16:12:35 2021 +0200 Use lexical-binding in cmuscheme.el * lisp/cmuscheme.el: Use lexical-binding. Doc fixes. Remove redundant :group args. Quote function symbols as such. diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d43cdb15c0..18087da9ac 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -1,7 +1,6 @@ -;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el +;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988-2021 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Maintainer: emacs-devel@gnu.org @@ -26,20 +25,18 @@ ;; This is a customization of comint-mode (see comint.el) ;; -;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces +;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces ;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al.. ;; 8/88 ;; ;; Please send me bug reports, bug fixes, and extensions, so that I can ;; merge them into the master source. ;; -;; The changelog is at the end of this file. -;; ;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user ;; interface that communicates process state back to the superior emacs by -;; outputting special control sequences. The Emacs package, xscheme.el, has +;; outputting special control sequences. The Emacs package, xscheme.el, has ;; lots and lots of special purpose code to read these control sequences, and -;; so is very tightly integrated with the cscheme process. The cscheme +;; so is very tightly integrated with the cscheme process. The cscheme ;; interrupt handler and debugger read single character commands in cbreak ;; mode; when this happens, xscheme.el switches to special keymaps that bind ;; the single letter command keys to emacs functions that directly send the @@ -49,18 +46,18 @@ ;; ;; Here's a summary of the pros and cons, as I see them. ;; xscheme: Tightly integrated with inferior cscheme process! A few commands -;; not in cmuscheme. But. Integration is a bit of a hack. Input -;; history only keeps the immediately prior input. Bizarre +;; not in cmuscheme. But. Integration is a bit of a hack. Input +;; history only keeps the immediately prior input. Bizarre ;; keybindings. ;; ;; cmuscheme: Not tightly integrated with inferior cscheme process. But. ;; Carefully integrated functionality with the entire suite of -;; comint-derived CMU process modes. Keybindings reminiscent of -;; Zwei and Hemlock. Good input history. A few commands not in +;; comint-derived CMU process modes. Keybindings reminiscent of +;; Zwei and Hemlock. Good input history. A few commands not in ;; xscheme. ;; -;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme -;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* +;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme +;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* ;; Cscheme-specific; you must use cmuscheme.el. Interested parties are ;; invited to port xscheme functionality on top of comint mode... @@ -70,18 +67,18 @@ ;; Created. ;; ;; 2/15/89 Olin -;; Removed -emacs flag from process invocation. It's only useful for +;; Removed -emacs flag from process invocation. It's only useful for ;; cscheme, and makes cscheme assume it's running under xscheme.el, -;; which messes things up royally. A bug. +;; which messes things up royally. A bug. ;; ;; 5/22/90 Olin ;; - Upgraded to use comint-send-string and comint-send-region. ;; - run-scheme now offers to let you edit the command line if -;; you invoke it with a prefix-arg. M-x scheme is redundant, and +;; you invoke it with a prefix-arg. M-x scheme is redundant, and ;; has been removed. ;; - Explicit references to process "scheme" have been replaced with -;; (scheme-proc). This allows better handling of multiple process bufs. -;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. +;; (scheme-proc). This allows better handling of multiple process bufs. +;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. ;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist ;; and friends, but interested hackers might find a useful application ;; of this facility. @@ -95,42 +92,37 @@ (require 'scheme) (require 'comint) - (defgroup cmuscheme nil "Run a scheme process in a buffer." :group 'scheme) -;;; INFERIOR SCHEME MODE STUFF -;;;============================================================================ - (defcustom inferior-scheme-mode-hook nil "Hook for customizing inferior-scheme mode." - :type 'hook - :group 'cmuscheme) + :type 'hook) (defvar inferior-scheme-mode-map (let ((m (make-sparse-keymap))) - (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention - (define-key m "\C-x\C-e" 'scheme-send-last-sexp) - (define-key m "\C-c\C-l" 'scheme-load-file) - (define-key m "\C-c\C-k" 'scheme-compile-file) + (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention + (define-key m "\C-x\C-e" #'scheme-send-last-sexp) + (define-key m "\C-c\C-l" #'scheme-load-file) + (define-key m "\C-c\C-k" #'scheme-compile-file) (scheme-mode-commands m) m)) ;; Install the process communication commands in the scheme-mode keymap. -(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention -(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention -(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition) -(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) -(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) -(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) -(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) -(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) -(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure) -(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form) -(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) -(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) -(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" +(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention +(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention +(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition) +(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go) +(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region) +(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go) +(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition) +(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go) +(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure) +(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form) +(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme) +(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file) +(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile" (let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) (define-key map [separator-eval] '("--")) @@ -157,8 +149,7 @@ (define-key map [send-region] '("Evaluate Region" . scheme-send-region)) (define-key map [send-sexp] - '("Evaluate Last S-expression" . scheme-send-last-sexp)) - ) + '("Evaluate Last S-expression" . scheme-send-last-sexp))) (defvar scheme-buffer) @@ -209,8 +200,7 @@ to continue it." (defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" "Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters." - :type 'regexp - :group 'cmuscheme) + :type 'regexp) (defun scheme-input-filter (str) "Don't save anything matching `inferior-scheme-filter-regexp'." @@ -242,7 +232,7 @@ is run). scheme-program-name))) (if (not (comint-check-proc "*scheme*")) (let ((cmdlist (split-string-and-unquote cmd))) - (set-buffer (apply 'make-comint "scheme" (car cmdlist) + (set-buffer (apply #'make-comint "scheme" (car cmdlist) (scheme-start-file (car cmdlist)) (cdr cmdlist))) (inferior-scheme-mode))) (setq scheme-program-name cmd) @@ -282,8 +272,7 @@ in this order. Return nil if no start file found." (defcustom scheme-compile-exp-command "(compile '%s)" "Template for issuing commands to compile arbitrary Scheme expressions." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-compile-region (start end) "Compile the current region in the inferior Scheme process. @@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\") For Scheme 48 and Scsh use \",trace %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defcustom scheme-untrace-command "(untrace %s)" "Template for switching off tracing of a Scheme procedure. Scheme 48 and Scsh users should set this variable to \",untrace %s\"." - - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-trace-procedure (proc &optional untrace) "Trace procedure PROC in the inferior Scheme process. @@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC." (defcustom scheme-macro-expand-command "(expand %s)" "Template for macro-expanding a Scheme form. For Scheme 48 and Scsh use \",expand %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-expand-current-form () "Macro-expand the form at point in the inferior Scheme process." @@ -410,8 +395,7 @@ Then switch to the process buffer." If it's loaded into a buffer that is in one of these major modes, it's considered a scheme source file by `scheme-load-file' and `scheme-compile-file'. Used by these commands to determine defaults." - :type '(repeat function) - :group 'cmuscheme) + :type '(repeat function)) (defvar scheme-prev-l/c-dir/file nil "Caches the last (directory . file) pair. @@ -514,8 +498,7 @@ command to run." (defcustom cmuscheme-load-hook nil "This hook is run when cmuscheme is loaded in. This is a good place to put keybindings." - :type 'hook - :group 'cmuscheme) + :type 'hook) (make-obsolete-variable 'cmuscheme-load-hook "use `with-eval-after-load' instead." "28.1") commit caeb86b439cae30c04f4d2b92f598bca2649218f Author: Stefan Kangas Date: Fri Apr 9 15:06:32 2021 +0200 * lisp/progmodes/cmacexp.el: Use lexical-binding. diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 820867ab41..edcd88ce24 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -1,7 +1,6 @@ -;;; cmacexp.el --- expand C macros in a region +;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2021 Free Software Foundation, Inc. ;; Author: Francesco Potortì ;; Adapted-By: ESR @@ -33,20 +32,20 @@ ;; USAGE ============================================================= -;; In C mode C-C C-e is bound to c-macro-expand. The result of the +;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the ;; expansion is put in a separate buffer. A user option allows the ;; window displaying the buffer to be optimally sized. ;; -;; When called with a C-u prefix, c-macro-expand replaces the selected +;; When called with a C-u prefix, `c-macro-expand' replaces the selected ;; region with the expansion. Both the preprocessor name and the -;; initial flag can be set by the user. If c-macro-prompt-flag is set +;; initial flag can be set by the user. If `c-macro-prompt-flag' is set ;; to a non-nil value the user is offered to change the options to the -;; preprocessor each time c-macro-expand is invoked. Preprocessor -;; arguments default to the last ones entered. If c-macro-prompt-flag +;; preprocessor each time `c-macro-expand' is invoked. Preprocessor +;; arguments default to the last ones entered. If `c-macro-prompt-flag' ;; is nil, one must use M-x set-variable to set a different value for -;; c-macro-cppflags. +;; `c-macro-cppflags'. -;; A c-macro-expansion function is provided for non-interactive use. +;; A `c-macro-expansion' function is provided for non-interactive use. ;; INSTALLATION ====================================================== @@ -54,18 +53,22 @@ ;; If you want the *Macroexpansion* window to be not higher than ;; necessary: -;;(setq c-macro-shrink-window-flag t) +;; +;; (setq c-macro-shrink-window-flag t) ;; ;; If you use a preprocessor other than /lib/cpp (be careful to set a ;; -C option or equivalent in order to make the preprocessor not to ;; strip the comments): -;;(setq c-macro-preprocessor "gpp -C") +;; +;; (setq c-macro-preprocessor "gpp -C") ;; ;; If you often use a particular set of flags: -;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" +;; +;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG" ;; ;; If you want the "Preprocessor arguments: " prompt: -;;(setq c-macro-prompt-flag t) +;; +;; (setq c-macro-prompt-flag t) ;; BUG REPORTS ======================================================= @@ -87,16 +90,12 @@ (require 'cc-mode) -(provide 'cmacexp) - (defvar msdos-shells) - (defgroup c-macro nil "Expand C macros in a region." :group 'c) - (defcustom c-macro-shrink-window-flag nil "Non-nil means shrink the *Macroexpansion* window to fit its contents." :type 'boolean) @@ -392,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the echo area." ;; Cleanup. (kill-buffer outbuf)))) +(provide 'cmacexp) + ;;; cmacexp.el ends here commit 064d933e20a007e6fbf0f2ce9e6554ca9710ed57 Author: Stefan Kangas Date: Fri Apr 9 14:54:04 2021 +0200 Use lexical-binding in foldout.el * lisp/foldout.el: Use lexical-binding. Doc and formatting fixes. Quote function symbols as such. diff --git a/lisp/foldout.el b/lisp/foldout.el index 3419d7f598..cadf2746ba 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -1,4 +1,4 @@ -;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode +;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- lexical-binding: t -*- ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. @@ -33,7 +33,7 @@ ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) ;; to expose the body or C-c C-i to expose the child (level-2) headings. ;; -;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body +;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body ;; and child subheadings and narrows the buffer so that only the level-1 ;; heading, the body and the level-2 headings are visible. If you now want to ;; look under one of the level-2 headings, position the cursor on it and do C-c @@ -57,7 +57,7 @@ ;; zoomed-in heading. This is useful for restricting changes to a particular ;; chapter or section of your document. ;; -;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides +;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides ;; all the text and subheadings under the top-level heading and returns you to ;; the previous view of the buffer. Specifying a numeric argument exits that ;; many folds. Specifying a zero argument exits *all* folds. @@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).") (defvar-local foldout-mode-line-string nil "Mode line string announcing that we are in an outline fold.") +;; FIXME: This should be rewritten as a proper minor mode. + ;; put our minor mode string immediately following outline-minor-mode's (or (assq 'foldout-mode-line-string minor-mode-alist) (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) @@ -227,8 +229,7 @@ An end marker of nil means the fold ends after (point-max).") (error "Can't find outline-minor-mode in minor-mode-alist")) ;; slip our fold announcement into the list - (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) - )) + (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))))) @@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:- ((> exposure-value 0) (outline-show-children exposure-value)) (t - (outline-show-subtree)) - ) + (outline-show-subtree))) ;; save the location of the fold we are entering (setq foldout-fold-list (cons (cons start-marker end-marker) foldout-fold-list)) ;; update the mode line - (foldout-update-mode-line) - ))) + (foldout-update-mode-line)))) (defun foldout-exit-fold (&optional num-folds) @@ -308,8 +307,7 @@ exited and text is left visible." ;; have we been told not to hide the fold? ((< num-folds 0) (setq hide-fold nil - num-folds (- num-folds))) - ) + num-folds (- num-folds)))) ;; limit the number of folds if we've been told to exit too many (setq num-folds (min num-folds (length foldout-fold-list))) @@ -482,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one." event) (defun foldout-mouse-goto-heading (event) - "Go to the heading where the mouse event started. Signal an error -if the event didn't occur on a heading." + "Go to the heading where the mouse EVENT started. +Signal an error if the event didn't occur on a heading." (goto-char (posn-point (event-start event))) (or (outline-on-heading-p) ;; outline.el sometimes treats beginning-of-buffer as a heading @@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}. Valid modifiers are shift, control, meta, alt, hyper and super.") -(if foldout-inhibit-key-bindings - () - (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) - (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) +(unless foldout-inhibit-key-bindings + (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree) + (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold) (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) (unless map (setq map (make-sparse-keymap)) (define-key outline-minor-mode-map outline-minor-mode-prefix map)) - (define-key map "\C-z" 'foldout-zoom-subtree) - (define-key map "\C-x" 'foldout-exit-fold)) - (let* ((modifiers (apply 'concat + (define-key map "\C-z" #'foldout-zoom-subtree) + (define-key map "\C-x" #'foldout-exit-fold)) + (let* ((modifiers (apply #'concat (mapcar (lambda (modifier) (vector (cond @@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") ((eq modifier 'alt) ?A) ((eq modifier 'hyper) ?H) ((eq modifier 'super) ?s) - (t (error "invalid mouse modifier %s" + (t (error "Invalid mouse modifier %s" modifier))) ?-)) foldout-mouse-modifiers))) @@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) - (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) + (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit) - (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) - )) + (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit))) ;; Obsolete. commit 841dcfa7c351118aef402e58c3a204b671e1fe13 Author: Stefan Kangas Date: Fri Apr 9 13:44:44 2021 +0200 Use lexical-binding in loadhist.el and add tests * lisp/loadhist.el: Use lexical-binding. * test/lisp/loadhist-tests.el: New file. diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 59c002d307..0b12bdad05 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -1,4 +1,4 @@ -;;; loadhist.el --- lisp functions for working with feature groups +;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc. diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el new file mode 100644 index 0000000000..b29796da42 --- /dev/null +++ b/test/lisp/loadhist-tests.el @@ -0,0 +1,57 @@ +;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'loadhist) + +(ert-deftest loadhist-tests-feature-symbols () + (should (equal (file-name-base (car (feature-symbols 'loadhist))) "loadhist")) + (should-not (feature-symbols 'non-existent-feature))) + +(ert-deftest loadhist-tests-feature-file () + (should (equal (file-name-base (feature-file 'loadhist)) "loadhist")) + (should-error (feature-file 'non-existent-feature))) + +(ert-deftest loadhist-tests-file-loadhist-lookup () + ;; This should probably be extended... + (should (listp (file-loadhist-lookup "loadhist")))) + +(ert-deftest loadhist-tests-file-provides () + (should (eq (car (file-provides "loadhist")) 'loadhist))) + +(ert-deftest loadhist-tests-file-requires () + (should-not (file-requires "loadhist"))) + +(ert-deftest loadhist-tests-file-dependents () + (require 'dired-x) + (let ((deps (file-dependents "dired"))) + (should (member "dired-x" (mapcar #'file-name-base deps))))) + +(ert-deftest loadhist-tests-unload-feature () + (require 'dired-x) + (should-error (unload-feature 'dired)) + (unload-feature 'dired-x)) + +;;; loadhist-tests.el ends here commit 612d73167688a9a9742478373933c4af5e3f8720 Author: Mattias Engdegård Date: Thu Apr 8 22:48:02 2021 +0200 Self-TCO in `condition-case` error handlers * lisp/emacs-lisp/cl-macs.el (cl--self-tco): Recognise `condition-case` handlers as being in the tail position. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Extend test. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 27ed07b667..68211ec410 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones. ;; tail-called any more. (not (memq var shadowings))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) + ((and `(condition-case ,err-var ,bodyform . ,handlers) + (guard (not (eq err-var var)))) + `(condition-case ,err-var + (progn (setq ,retvar ,bodyform) nil) + . ,(mapcar (lambda (h) + (cons (car h) (funcall opt-exps (cdr h)))) + handlers))) ('nil nil) ;No need to set `retvar' to return nil. (_ `(progn (setq ,retvar ,exp) nil)))))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index dd6487603d..5c3e603b92 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -629,14 +629,24 @@ collection clause." (let (n1) (and xs (progn (setq n1 (1+ n)) - (len2 (cdr xs) n1))))))) + (len2 (cdr xs) n1)))))) + ;; Tail call in error handler. + (len3 (xs n) + (if xs + (condition-case nil + (/ 1 0) + (arith-error (len3 (cdr xs) (1+ n)))) + n))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) + (should (equal (len3 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) + (should (equal (len3 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) - (should (equal (len2 list-42k 0) 42000)))) + (should (equal (len2 list-42k 0) 42000)) + (should (equal (len3 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) commit 5b1e7af7bf7b47ab3eabc9ccd1d5419554c95d0c Author: Stefan Monnier Date: Wed Mar 24 22:59:52 2021 -0400 * lisp/progmodes/vhdl-mode.el: Use lexical-binding Use #' to quote function names to get better compiler diagnostics. Wrap some lines to avoid arguments "hidden" in positions that are easy to misread. Prefix unused arguments with a semi-colon to silence compiler warnings. Fix a few comments that used ;;; even though they were not headings. (vhdl-emacs-21): Delete variable. Replace all uses with (not (featurep 'xemacs)) instead since `vhdl-mode` has been incompatible with Emacs<21 for more than 10 years already. (vhdl-prepare-search-1): Add Edebug declaration. (vhdl-prepare-search-2): Add Edebug declaration and use `with-syntax-table`. (vhdl-visit-file): Add Edebug and indentation declaration. Move the bulk of the code to a function for easier debugging. (vhdl--visit-file): New function extracted from `vhdl-visit-file`. Be careful not to modify syntax tables in unrelated buffers. (vhdl-speedbar-refresh): Remove unused var `pos`. (vhdl-backward-sexp): Remove unused var `last-forward`. (vhdl-electric-tab, vhdl-minibuffer-tab, vhdl-line-expand): Rename arg to avoid conflict with the `prefix-arg` global variable. (vhdl-align-region-1): Remove unused var `indent`. (vhdl-character-to-event): Actually give a body to that poor function. (vhdl-template-context): Remove unused vars `entity-exists` and `string`. (vhdl-template-group): Remove unused var `start`. (vhdl-template-argument-list): Remove unused var `start`. (vhdl-port-paste-context-clause): Remove unused var `margin`. (vhdl-port-paste-testbench): Remove unused var `source-buffer`. (vhdl-hs-minor-mode): Declare function `hs-hide-all`. (vhdl-get-hierarchy): Rename arguments `ent-alist`, `conf-alist`, and `conf-key` and bind those dynamically scoped var via `let` instead since arguments can't be dynamically scoped. (vhdl-speedbar-insert-hierarchy, vhdl-compose-configuration-architecture): Same thing with arguments `ent-alist` and `conf-alist`. (vhdl-cache-version): Declare variable. (speedbar-expand-line, speedbar-edit-line): Declare functions. (vhdl-speedbar-update-current-unit): Declare before first use. (vhdl-compose-new-component): Remove unused var `project`. (lazy-lock-minimum-size): Declare variable. (vhdl-submit-bug-report): Declare variable `reporter-prompt-for-summary-p`. diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f4a39c29ca..be98066a62 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -1,4 +1,4 @@ -;;; vhdl-mode.el --- major mode for editing VHDL code +;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*- ;; Copyright (C) 1992-2021 Free Software Foundation, Inc. @@ -77,7 +77,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation -;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. +;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21. ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation ;; or into an arbitrary directory that is added to the load path by the @@ -92,7 +92,7 @@ ;; Add the following lines to the `site-start.el' file in the `site-lisp' ;; directory of your Emacs installation or to your Emacs start-up file `.emacs' -;; (not required in Emacs 20 and higher): +;; (not required in Emacs): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) ;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) @@ -136,12 +136,9 @@ (when (< emacs-major-version 25) (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) -;; Emacs 21+ handling -(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 21, 22, ... is used.") ;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 22, ... is used.") + "Non-nil if GNU Emacs >= 22, ... is used.") (defvar compilation-file-regexp-alist) (defvar conf-alist) @@ -490,7 +487,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Upcase" upcase) (const :tag "Downcase" downcase)))))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + (vhdl-custom-set variable value #'vhdl-update-mode-menu)) :version "24.4" :group 'vhdl-compile) @@ -668,8 +665,8 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' :format "%t\n%v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-update-mode-menu - 'vhdl-speedbar-refresh)) + #'vhdl-update-mode-menu + #'vhdl-speedbar-refresh)) :group 'vhdl-project) (defcustom vhdl-project nil @@ -713,7 +710,7 @@ All project setup files that match the file names specified in option \(alphabetically) last loaded setup of the first `vhdl-project-file-name' entry is activated. A project setup file can be obtained by exporting a project (see menu). - At startup: project setup file is loaded at Emacs startup" + At startup: project setup file is loaded at Emacs startup." :type '(set (const :tag "At startup" startup)) :group 'vhdl-project) @@ -751,12 +748,12 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (const :tag "Math packages" math))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-template-map-init - 'vhdl-mode-abbrev-table-init - 'vhdl-template-construct-alist-init - 'vhdl-template-package-alist-init - 'vhdl-update-mode-menu - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-template-map-init + #'vhdl-mode-abbrev-table-init + #'vhdl-template-construct-alist-init + #'vhdl-template-package-alist-init + #'vhdl-update-mode-menu + #'vhdl-words-init 'vhdl-font-lock-init)) :group 'vhdl-style) (defcustom vhdl-basic-offset 2 @@ -770,7 +767,7 @@ This value is used by + and - symbols in `vhdl-offsets-alist'." This is done when typed or expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-types nil @@ -778,7 +775,7 @@ This is done when typed or expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-attributes nil @@ -786,7 +783,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-enum-values nil @@ -794,7 +791,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-constants t @@ -802,7 +799,7 @@ This is done when expanded or by the fix case functions." This is done when expanded." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-use-direct-instantiation 'standard @@ -909,7 +906,7 @@ follows: :type '(set (const :tag "VHDL keywords" vhdl) (const :tag "User model keywords" user)) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) + (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init)) :group 'vhdl-template) (defcustom vhdl-optional-labels 'process @@ -1192,10 +1189,10 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (string :tag "Keyword " :format "%t: %v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-model-map-init - 'vhdl-model-defun - 'vhdl-mode-abbrev-table-init - 'vhdl-update-mode-menu)) + #'vhdl-model-map-init + #'vhdl-model-defun + #'vhdl-mode-abbrev-table-init + #'vhdl-update-mode-menu)) :group 'vhdl-model) @@ -1598,7 +1595,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-names t @@ -1615,7 +1612,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-special-words nil @@ -1628,7 +1625,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-forbidden-words nil @@ -1643,7 +1640,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-verilog-keywords nil @@ -1656,7 +1653,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-translate-off nil @@ -1670,7 +1667,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-case-sensitive nil @@ -1724,7 +1721,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu (string :tag "Color (dark) ") (boolean :tag "In comments "))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-words '() @@ -1737,7 +1734,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-syntax "" @@ -1752,7 +1749,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'regexp :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") @@ -1763,7 +1760,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) @@ -2238,11 +2235,11 @@ Ignore byte-compiler warnings you might see." ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") (defun regexp-opt (strings &optional paren) (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat 'regexp-quote strings "\\|") close)))) + (concat open (mapconcat #'regexp-quote strings "\\|") close)))) ;; `match-string-no-properties' undefined (XEmacs, what else?) (unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) + (defalias 'match-string-no-properties #'match-string)) ;; `subst-char-in-string' undefined (XEmacs) (unless (fboundp 'subst-char-in-string) @@ -2269,7 +2266,7 @@ Ignore byte-compiler warnings you might see." (let* ((nondir (file-name-nondirectory pattern)) (dirpart (file-name-directory pattern)) (dirs (if (and dirpart (string-match "[[*?]" dirpart)) - (mapcar 'file-name-as-directory + (mapcar #'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) contents) @@ -2296,7 +2293,7 @@ Ignore byte-compiler warnings you might see." ;; `member-ignore-case' undefined (XEmacs) (unless (fboundp 'member-ignore-case) - (defalias 'member-ignore-case 'member)) + (defalias 'member-ignore-case #'member)) ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different ;; behavior in XEmacs @@ -2495,6 +2492,7 @@ current buffer if no project is defined." "Enable case insensitive search and switch to syntax table that includes `_', then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t)) ; case insensitive search ;; use extended syntax table (with-syntax-table vhdl-mode-ext-syntax-table @@ -2504,55 +2502,59 @@ consistent searching." "Enable case insensitive search, switch to syntax table that includes `_', arrange to ignore `intangible' overlays, then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t) ; case insensitive search - (current-syntax-table (syntax-table)) (inhibit-point-motion-hooks t)) ;; use extended syntax table - (set-syntax-table vhdl-mode-ext-syntax-table) - ;; execute BODY safely - (unwind-protect - (progn ,@body) - ;; restore syntax table - (set-syntax-table current-syntax-table)))) + (with-syntax-table vhdl-mode-ext-syntax-table + ;; execute BODY safely + (progn ,@body)))) (defmacro vhdl-visit-file (file-name issue-error &rest body) "Visit file FILE-NAME and execute BODY." - `(if (null ,file-name) - (progn ,@body) - (unless (file-directory-p ,file-name) - (let ((source-buffer (current-buffer)) - (visiting-buffer (find-buffer-visiting ,file-name)) - file-opened) - (when (or (and visiting-buffer (set-buffer visiting-buffer)) - (condition-case () - (progn (set-buffer (create-file-buffer ,file-name)) - (setq file-opened t) - (vhdl-insert-file-contents ,file-name) - ;; FIXME: This modifies a global syntax-table! - (modify-syntax-entry ?\- ". 12" (syntax-table)) - (modify-syntax-entry ?\n ">" (syntax-table)) - (modify-syntax-entry ?\^M ">" (syntax-table)) - (modify-syntax-entry ?_ "w" (syntax-table)) - t) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) - (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) - nil)))) - (condition-case info - (progn ,@body) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error (cadr info))) - (vhdl-warning (cadr info)))))) - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer))))) + (declare (debug t) (indent 2)) + `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body))) + +(defun vhdl--visit-file (file-name issue-error body-fun) + (if (null file-name) + (funcall body-fun) + (unless (file-directory-p file-name) + (let ((source-buffer (current-buffer)) + (visiting-buffer (find-buffer-visiting file-name)) + file-opened) + (when (or (and visiting-buffer (set-buffer visiting-buffer)) + (condition-case () + (progn (set-buffer (create-file-buffer file-name)) + (setq file-opened t) + (vhdl-insert-file-contents file-name) + (let ((st (copy-syntax-table (syntax-table)))) + (modify-syntax-entry ?\- ". 12" st) + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\^M ">" st) + (modify-syntax-entry ?_ "w" st) + ;; FIXME: We should arguably reset the + ;; syntax-table after running `body-fun'. + (set-syntax-table st)) + t) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error "ERROR: File cannot be opened: \"%s\"" file-name)) + (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t) + nil)))) + (condition-case info + (funcall body-fun) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error (cadr info))) + (vhdl-warning (cadr info)))))) + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer))))) (defun vhdl-insert-file-contents (filename) "Nicked from `insert-file-contents-literally', but allow coding system @@ -2600,7 +2602,7 @@ conversion." "Refresh directory or project with name KEY." (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (let ((pos (point)) + (let (;; (pos (point)) (last-frame (selected-frame))) (if (null key) (speedbar-refresh) @@ -2677,96 +2679,96 @@ elements > `vhdl-menu-max-size'." "Initialize `vhdl-template-map'." (setq vhdl-template-map (make-sparse-keymap)) ;; key bindings for VHDL templates - (define-key vhdl-template-map "al" 'vhdl-template-alias) - (define-key vhdl-template-map "ar" 'vhdl-template-architecture) - (define-key vhdl-template-map "at" 'vhdl-template-assert) - (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) - (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) - (define-key vhdl-template-map "bl" 'vhdl-template-block) - (define-key vhdl-template-map "ca" 'vhdl-template-case-is) - (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) - (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) - (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) - (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) - (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) - (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) - (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) - (define-key vhdl-template-map "co" 'vhdl-template-constant) - (define-key vhdl-template-map "ct" 'vhdl-template-context) - (define-key vhdl-template-map "di" 'vhdl-template-disconnect) - (define-key vhdl-template-map "el" 'vhdl-template-else) - (define-key vhdl-template-map "ei" 'vhdl-template-elsif) - (define-key vhdl-template-map "en" 'vhdl-template-entity) - (define-key vhdl-template-map "ex" 'vhdl-template-exit) - (define-key vhdl-template-map "fi" 'vhdl-template-file) - (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) - (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) - (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) - (define-key vhdl-template-map "fb" 'vhdl-template-function-body) - (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) - (define-key vhdl-template-map "ge" 'vhdl-template-generic) - (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) - (define-key vhdl-template-map "gt" 'vhdl-template-group-template) - (define-key vhdl-template-map "\C-h" 'vhdl-template-header) - (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) - (define-key vhdl-template-map "it" 'vhdl-template-if-then) - (define-key vhdl-template-map "li" 'vhdl-template-library) - (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) - (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) - (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) - (define-key vhdl-template-map "ma" 'vhdl-template-map) - (define-key vhdl-template-map "ne" 'vhdl-template-next) - (define-key vhdl-template-map "ot" 'vhdl-template-others) - (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) - (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) - (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) - (define-key vhdl-template-map "po" 'vhdl-template-port) - (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) - (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) - (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) - (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) - (define-key vhdl-template-map "rp" 'vhdl-template-report) - (define-key vhdl-template-map "rt" 'vhdl-template-return) - (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) - (define-key vhdl-template-map "si" 'vhdl-template-signal) - (define-key vhdl-template-map "su" 'vhdl-template-subtype) - (define-key vhdl-template-map "ty" 'vhdl-template-type) - (define-key vhdl-template-map "us" 'vhdl-template-use) - (define-key vhdl-template-map "va" 'vhdl-template-variable) - (define-key vhdl-template-map "wa" 'vhdl-template-wait) - (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) - (define-key vhdl-template-map "wi" 'vhdl-template-with) - (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) - (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) - (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) - (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) - (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) - (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) - (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) - (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) - (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) - (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) - (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) - (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) - (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) - (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) - (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) + (define-key vhdl-template-map "al" #'vhdl-template-alias) + (define-key vhdl-template-map "ar" #'vhdl-template-architecture) + (define-key vhdl-template-map "at" #'vhdl-template-assert) + (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl) + (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec) + (define-key vhdl-template-map "bl" #'vhdl-template-block) + (define-key vhdl-template-map "ca" #'vhdl-template-case-is) + (define-key vhdl-template-map "cd" #'vhdl-template-component-decl) + (define-key vhdl-template-map "ci" #'vhdl-template-component-inst) + (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst) + (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration) + (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf) + (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl) + (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec) + (define-key vhdl-template-map "co" #'vhdl-template-constant) + (define-key vhdl-template-map "ct" #'vhdl-template-context) + (define-key vhdl-template-map "di" #'vhdl-template-disconnect) + (define-key vhdl-template-map "el" #'vhdl-template-else) + (define-key vhdl-template-map "ei" #'vhdl-template-elsif) + (define-key vhdl-template-map "en" #'vhdl-template-entity) + (define-key vhdl-template-map "ex" #'vhdl-template-exit) + (define-key vhdl-template-map "fi" #'vhdl-template-file) + (define-key vhdl-template-map "fg" #'vhdl-template-for-generate) + (define-key vhdl-template-map "fl" #'vhdl-template-for-loop) + (define-key vhdl-template-map "\C-f" #'vhdl-template-footer) + (define-key vhdl-template-map "fb" #'vhdl-template-function-body) + (define-key vhdl-template-map "fd" #'vhdl-template-function-decl) + (define-key vhdl-template-map "ge" #'vhdl-template-generic) + (define-key vhdl-template-map "gd" #'vhdl-template-group-decl) + (define-key vhdl-template-map "gt" #'vhdl-template-group-template) + (define-key vhdl-template-map "\C-h" #'vhdl-template-header) + (define-key vhdl-template-map "ig" #'vhdl-template-if-generate) + (define-key vhdl-template-map "it" #'vhdl-template-if-then) + (define-key vhdl-template-map "li" #'vhdl-template-library) + (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop) + (define-key vhdl-template-map "\C-m" #'vhdl-template-modify) + (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date) + (define-key vhdl-template-map "ma" #'vhdl-template-map) + (define-key vhdl-template-map "ne" #'vhdl-template-next) + (define-key vhdl-template-map "ot" #'vhdl-template-others) + (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl) + (define-key vhdl-template-map "Pb" #'vhdl-template-package-body) + (define-key vhdl-template-map "(" #'vhdl-template-paired-parens) + (define-key vhdl-template-map "po" #'vhdl-template-port) + (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body) + (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl) + (define-key vhdl-template-map "pc" #'vhdl-template-process-comb) + (define-key vhdl-template-map "ps" #'vhdl-template-process-seq) + (define-key vhdl-template-map "rp" #'vhdl-template-report) + (define-key vhdl-template-map "rt" #'vhdl-template-return) + (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst) + (define-key vhdl-template-map "si" #'vhdl-template-signal) + (define-key vhdl-template-map "su" #'vhdl-template-subtype) + (define-key vhdl-template-map "ty" #'vhdl-template-type) + (define-key vhdl-template-map "us" #'vhdl-template-use) + (define-key vhdl-template-map "va" #'vhdl-template-variable) + (define-key vhdl-template-map "wa" #'vhdl-template-wait) + (define-key vhdl-template-map "wl" #'vhdl-template-while-loop) + (define-key vhdl-template-map "wi" #'vhdl-template-with) + (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait) + (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit) + (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std) + (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164) + (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith) + (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc) + (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed) + (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio) + (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned) + (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio) + (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on) + (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off) + (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on) + (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off) + (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt) (when (vhdl-standard-p 'ams) - (define-key vhdl-template-map "br" 'vhdl-template-break) - (define-key vhdl-template-map "cu" 'vhdl-template-case-use) - (define-key vhdl-template-map "iu" 'vhdl-template-if-use) - (define-key vhdl-template-map "lm" 'vhdl-template-limit) - (define-key vhdl-template-map "na" 'vhdl-template-nature) - (define-key vhdl-template-map "pa" 'vhdl-template-procedural) - (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) - (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) - (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) - (define-key vhdl-template-map "sn" 'vhdl-template-subnature) - (define-key vhdl-template-map "te" 'vhdl-template-terminal) + (define-key vhdl-template-map "br" #'vhdl-template-break) + (define-key vhdl-template-map "cu" #'vhdl-template-case-use) + (define-key vhdl-template-map "iu" #'vhdl-template-if-use) + (define-key vhdl-template-map "lm" #'vhdl-template-limit) + (define-key vhdl-template-map "na" #'vhdl-template-nature) + (define-key vhdl-template-map "pa" #'vhdl-template-procedural) + (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free) + (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch) + (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source) + (define-key vhdl-template-map "sn" #'vhdl-template-subnature) + (define-key vhdl-template-map "te" #'vhdl-template-terminal) ) (when (vhdl-standard-p 'math) - (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) - (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) + (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex) + (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real) )) ;; initialize template map for VHDL Mode @@ -2812,119 +2814,120 @@ STRING are replaced by `-' and substrings are converted to lower case." ;; model key bindings (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) ;; standard key bindings - (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) - (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) - (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) - (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) - (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) - (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) - (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) + (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement) + (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement) + (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp) + (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp) + (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list) + (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent) + (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent) (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs - (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) - (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) - (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) + (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun)) + (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp) + (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation) ;; mode specific key bindings - (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) - (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) - (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) - (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) - (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) - (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) - (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) - (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) - (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) - (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) - (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) - (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) - (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) - (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) - (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) - (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs - (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) - (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) - (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) - (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) - (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) - (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) - (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) - (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) - (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) - (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) - (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) - (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) - (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) - (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) - (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) - (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) - (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) - (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) - (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) - (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) - (define-key vhdl-mode-map "\M-\C-\\" 'indent-region) - (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) - (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) - (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) - (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) - (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) - (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) - (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) - (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) - (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) - (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) - (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) - (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) - (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) - (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) - (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) - (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) - (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) - (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) - (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) - (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) - (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) - (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) - (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) - (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) - (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) - (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) - (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) - (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) - (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) - (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) - (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) - (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) - (define-key vhdl-mode-map "\M-\t" 'insert-tab) + (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode) + (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode) + (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project) + (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project) + (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project) + (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project) + (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler) + (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile) + (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make) + (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile) + (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity) + (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component) + (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance) + (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals) + (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants) + (define-key vhdl-mode-map + ;; `... C-g' not allowed in XEmacs. + (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g") + #'vhdl-port-paste-generic-map) + (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations) + (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench) + (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten) + (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction) + (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration) + (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body) + (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call) + (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten) + (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component) + (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component) + (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components) + (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration) + (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package) + (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region) + (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline) + (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line) + (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode) + (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group) + (define-key vhdl-mode-map "\M-\C-\\" #'indent-region) + (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent) + (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list) + (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations) + (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region) + (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group) + (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region) + (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group) + (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent) + (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region) + (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill) + (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy) + (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank) + (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand) + (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next) + (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous) + (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open) + (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line) + (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer) + (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause) + (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region) + (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer) + (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region) + (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer) + (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region) + (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer) + (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process) + (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer) + (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages) + (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode) + (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version) + (define-key vhdl-mode-map "\M-\t" #'insert-tab) ;; insert commands bindings - (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) - (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) - (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) - (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) + (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct) + (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package) + (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive) + (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert) ;; electric key bindings - (define-key vhdl-mode-map " " 'vhdl-electric-space) + (define-key vhdl-mode-map " " #'vhdl-electric-space) (when vhdl-intelligent-tab - (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) - (define-key vhdl-mode-map "\r" 'vhdl-electric-return) - (define-key vhdl-mode-map "-" 'vhdl-electric-dash) - (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) - (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) - (define-key vhdl-mode-map "'" 'vhdl-electric-quote) - (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) - (define-key vhdl-mode-map "," 'vhdl-electric-comma) - (define-key vhdl-mode-map "." 'vhdl-electric-period) + (define-key vhdl-mode-map "\t" #'vhdl-electric-tab)) + (define-key vhdl-mode-map "\r" #'vhdl-electric-return) + (define-key vhdl-mode-map "-" #'vhdl-electric-dash) + (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket) + (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket) + (define-key vhdl-mode-map "'" #'vhdl-electric-quote) + (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon) + (define-key vhdl-mode-map "," #'vhdl-electric-comma) + (define-key vhdl-mode-map "." #'vhdl-electric-period) (when (vhdl-standard-p 'ams) - (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) + (define-key vhdl-mode-map "=" #'vhdl-electric-equal))) ;; initialize mode map for VHDL Mode (vhdl-mode-map-init) @@ -2935,7 +2938,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (when vhdl-word-completion-in-minibuffer - (define-key map "\t" 'vhdl-minibuffer-tab)) + (define-key map "\t" #'vhdl-minibuffer-tab)) map) "Keymap for minibuffer used in VHDL Mode.") @@ -3168,7 +3171,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (unless (equal keyword "") (push (list keyword "" (vhdl-function-name - "vhdl-model" (nth 0 elem) "hook") 0 'system) + "vhdl-model" (nth 0 elem) "hook") + 0 'system) abbrev-list))) abbrev-list))))) @@ -4885,7 +4889,7 @@ Key bindings: (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) + (set (make-local-variable 'indent-line-function) #'vhdl-indent-line) (set (make-local-variable 'comment-start) "--") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-column) vhdl-inline-comment-column) @@ -4898,13 +4902,13 @@ Key bindings: ;; setup the comment indent variable in an Emacs version portable way ;; ignore any byte compiler warnings you might get here (when (boundp 'comment-indent-function) - (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) + (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent)) ;; initialize font locking (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line)) (if (eval-when-compile (fboundp 'syntax-propertize-rules)) (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-rules @@ -4913,7 +4917,7 @@ Key bindings: ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) (set (make-local-variable 'font-lock-syntactic-keywords) vhdl-font-lock-syntactic-keywords)) - (unless vhdl-emacs-21 + (when (featurep 'xemacs) (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) @@ -4959,10 +4963,10 @@ Key bindings: (defun vhdl-write-file-hooks-init () "Add/remove hooks when buffer is saved." (if vhdl-modify-date-on-saving - (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) - (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) + (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t) + (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t)) (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) - (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) + (add-hook 'after-save-hook #'vhdl-add-modified-file nil t)) (defun vhdl-process-command-line-option (option) "Process command line options for VHDL Mode." @@ -5745,7 +5749,7 @@ negative, skip forward otherwise." ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ (unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) - (defalias 'vhdl-forward-comment 'forward-comment)) + (defalias 'vhdl-forward-comment #'forward-comment)) (defun vhdl-back-to-indentation () "Move point to the first non-whitespace character on this line." @@ -5809,7 +5813,7 @@ negative, skip forward otherwise." state))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-in-literal 'vhdl-win-il)) + (fset 'vhdl-in-literal #'vhdl-win-il)) ;; Skipping of "syntactic whitespace". Syntactic whitespace is ;; defined as lexical whitespace or comments. Search no farther back @@ -5847,9 +5851,9 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) + (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws)) -(defun vhdl-beginning-of-macro (&optional lim) +(defun vhdl-beginning-of-macro (&optional _lim) "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5862,7 +5866,7 @@ negative, skip forward otherwise." (goto-char here) nil))) -(defun vhdl-beginning-of-directive (&optional lim) +(defun vhdl-beginning-of-directive (&optional _lim) "Go to the beginning of a directive (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5906,7 +5910,7 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) + (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws)) ;; Functions to help finding the correct indentation column: @@ -6054,7 +6058,7 @@ keyword." t) )) -(defun vhdl-corresponding-mid (&optional lim) +(defun vhdl-corresponding-mid (&optional _lim) (cond ((looking-at "is\\|block\\|generate\\|process\\|procedural") "begin") @@ -6270,7 +6274,7 @@ of an identifier that just happens to contain an \"end\" keyword." "A regular expression for searching backward that matches all known \"statement\" keywords.") -(defun vhdl-statement-p (&optional lim) +(defun vhdl-statement-p (&optional _lim) "Return t if we are looking at a real \"statement\" keyword. Assumes that the caller will make sure that we are looking at vhdl-statement-fwd-re, and are not inside a literal, and that we are not @@ -6462,7 +6466,7 @@ searches." ;; internal-p controls where the statement keyword can ;; be found. (internal-p (aref begin-vec 3)) - (last-backward (point)) last-forward + (last-backward (point)) ;; last-forward foundp literal keyword) ;; Look for the statement keyword. (while (and (not foundp) @@ -6497,7 +6501,7 @@ searches." (setq begin-re (concat "\\b\\(" begin-re "\\)\\b[^_]")) (save-excursion - (setq last-forward (point)) + ;; (setq last-forward (point)) ;; Look for the supplementary keyword ;; (bounded by the backward search start ;; point). @@ -6549,7 +6553,7 @@ With argument, do this that many times." (setq target (point))) (goto-char target))) -(defun vhdl-end-of-defun (&optional count) +(defun vhdl-end-of-defun (&optional _count) "Move forward to the end of a VHDL defun." (interactive) (let ((case-fold-search t)) @@ -7321,7 +7325,7 @@ after the containing paren which starts the arglist." (current-column)))) (- ce-curcol cs-curcol -1)))) -(defun vhdl-lineup-comment (langelem) +(defun vhdl-lineup-comment (_langelem) "Support old behavior for comment indentation. We look at vhdl-comment-only-line-offset to decide how to indent comment only-lines." @@ -7389,7 +7393,7 @@ only-lines." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation commands -(defun vhdl-electric-tab (&optional prefix-arg) +(defun vhdl-electric-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else if right of non whitespace on line then insert tab, else if last command was a tab or return then dedent one step or if a comment @@ -7409,12 +7413,12 @@ else indent `correctly'." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab ((> (current-column) (current-indentation)) (insert-tab)) @@ -7473,7 +7477,7 @@ indentation change." (setq syntax (vhdl-get-syntactic-context))))) (when is-comment (push (cons 'comment nil) syntax)) - (apply '+ (mapcar 'vhdl-get-offset syntax))) + (apply #'+ (mapcar #'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) (re-search-backward "^[^\n]" nil t) @@ -7677,7 +7681,7 @@ parentheses." ;; run FUNCTION (funcall function beg end spacing))) -(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) +(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent) "Attempt to align a range of lines based on the content of the lines. The definition of `alignment-list' determines the matching order and the manner in which the lines are aligned. If ALIGNMENT-LIST @@ -7687,12 +7691,15 @@ indentation is done before aligning." (setq alignment-list (or alignment-list vhdl-align-alist)) (setq spacing (or spacing 1)) (save-excursion - (let (bol indent) + (let (bol) ;; indent (goto-char end) (setq end (point-marker)) (goto-char begin) (setq bol (setq begin (progn (beginning-of-line) (point)))) - (when indent + ;; FIXME: The `indent' arg is not used, and I think it's because + ;; the let binding commented out above `indent' was hiding it, so + ;; the test below should maybe still test `indent'? + (when nil ;; indent (indent-region bol end nil)))) (let ((copy (copy-alist alignment-list))) (vhdl-prepare-search-2 @@ -8015,7 +8022,7 @@ empty lines are aligned individually, if `vhdl-align-groups' is non-nil." (tabify orig end)) (unless no-message (message "Aligning inline comments...done"))))) -(defun vhdl-align-inline-comment-group (&optional spacing) +(defun vhdl-align-inline-comment-group (&optional _spacing) "Align inline comments within a group of lines between empty lines." (interactive) (save-excursion @@ -8125,10 +8132,10 @@ depending on parameter UPPER-CASE." (when pr (progress-reporter-update pr (point)))) (when pr (progress-reporter-done pr)))))) -(defun vhdl-fix-case-region (beg end &optional arg) +(defun vhdl-fix-case-region (beg end &optional _arg) "Convert all VHDL words in region to lower or upper case, depending on options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") + (interactive "r") (vhdl-fix-case-region-1 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) (vhdl-fix-case-region-1 @@ -8174,11 +8181,11 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." ;; - force each statement to be on a separate line except when on same line ;; with 'end' keyword -(defun vhdl-fix-statement-region (beg end &optional arg) +(defun vhdl-fix-statement-region (beg end &optional _arg) "Force statements in region on separate line except when on same line with `end' keyword (necessary for correct indentation). Currently supported keywords: `begin', `if'." - (interactive "r\nP") + (interactive "r") (vhdl-prepare-search-2 (let (point) (save-excursion @@ -8230,9 +8237,9 @@ with `end' keyword (necessary for correct indentation)." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Trailing spaces -(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) +(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg) "Remove trailing spaces in region." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char end) (setq end (point-marker)) @@ -8495,7 +8502,7 @@ buffer." (delete-region sens-beg sens-end) (when read-list (insert " ()") (backward-char))) - (setq read-list (sort read-list 'string<)) + (setq read-list (sort read-list #'string<)) (when read-list (setq margin (current-column)) (insert (car read-list)) @@ -8527,7 +8534,7 @@ buffer." (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) "." (file-name-extension (buffer-file-name))))) (vhdl-visit-file - file-name t + file-name t (vhdl-prepare-search-2 (goto-char (point-min)) (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) @@ -8535,7 +8542,8 @@ buffer." (when (setq beg (vhdl-re-search-forward "\\" nil t)) t)) + (re-search-forward "^end\\>" nil t)) + t)) (setq end (save-excursion (backward-char) (forward-sexp) (point))) (vhdl-forward-syntactic-ws) @@ -8667,9 +8675,9 @@ buffer." Used for undoing after template abortion.") ;; correct different behavior of function `unread-command-events' in XEmacs -(defun vhdl-character-to-event (arg)) +(defun vhdl-character-to-event (_arg) nil) (defalias 'vhdl-character-to-event - (if (fboundp 'character-to-event) 'character-to-event 'identity)) + (if (fboundp 'character-to-event) #'character-to-event #'identity)) (defun vhdl-work-library () "Return the working library name of the current project or \"work\" if no @@ -9126,7 +9134,8 @@ a configuration declaration if not within a design unit." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "configuration" "(b)lock or (c)omponent configuration?" t) ?c) + "configuration" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) (t (vhdl-template-configuration-decl))))) ; otherwise @@ -9235,7 +9244,7 @@ a configuration declaration if not within a design unit." (interactive) (let ((margin (current-indentation)) (start (point)) - entity-exists string name position) + name position) ;; entity-exists string (vhdl-insert-keyword "CONTEXT ") (when (setq name (vhdl-template-field "name" nil t start (point))) (vhdl-insert-keyword " IS\n") @@ -9391,7 +9400,8 @@ otherwise." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "for" "(b)lock or (c)omponent configuration?" t) ?c) + "for" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) ((and (save-excursion @@ -9506,11 +9516,12 @@ otherwise." (defun vhdl-template-group () "Insert group or group template declaration." (interactive) - (let ((start (point))) - (if (eq (vhdl-decision-query - "group" "(d)eclaration or (t)emplate declaration?" t) ?t) - (vhdl-template-group-template) - (vhdl-template-group-decl)))) + ;; (let ((start (point))) + (if (eq (vhdl-decision-query + "group" "(d)eclaration or (t)emplate declaration?" t) + ?t) + (vhdl-template-group-template) + (vhdl-template-group-decl))) ;; ) (defun vhdl-template-group-decl () "Insert group declaration." @@ -10451,7 +10462,8 @@ specification, if not already there." (and (not (bobp)) (re-search-backward (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" - library "\\|end\\)\\>") nil t) + library "\\|end\\)\\>") + nil t) (match-string 2)))) (equal (downcase library) "work")) (vhdl-insert-keyword "LIBRARY ") @@ -10811,9 +10823,9 @@ If starting after end-comment-column, start a new line." (vhdl-line-kill-entire))))) (goto-char final-pos)))) -(defun vhdl-comment-uncomment-region (beg end &optional arg) +(defun vhdl-comment-uncomment-region (beg end &optional _arg) "Comment out region if not commented out, uncomment otherwise." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char (1- end)) (end-of-line) @@ -10890,7 +10902,7 @@ Point is left between them." "Read from user a procedure or function argument list." (insert " (") (let ((margin (current-column)) - (start (point)) + ;; (start (point)) (end-pos (point)) not-empty interface semicolon-pos) (unless vhdl-argument-list-indent @@ -10899,7 +10911,8 @@ Point is left between them." (indent-to margin)) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t)) + (unless is-function " | VARIABLE") "]") + " " t)) (while (vhdl-template-field "[names]" nil t) (setq not-empty t) (insert " : ") @@ -10916,7 +10929,8 @@ Point is left between them." (indent-to margin) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t))) + (unless is-function " | VARIABLE") "]") + " " t))) (delete-region end-pos (point)) (when semicolon-pos (goto-char semicolon-pos)) (if not-empty @@ -11136,7 +11150,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string." "Adjust case of following NUM words." (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) -(defun vhdl-minibuffer-tab (&optional prefix-arg) +(defun vhdl-minibuffer-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else insert tab (used for word completion in VHDL minibuffer)." (interactive "P") @@ -11149,12 +11163,12 @@ else insert tab (used for word completion in VHDL minibuffer)." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab (t (insert-tab)))) @@ -11541,7 +11555,8 @@ but not if inside a comment or quote." (unless (equal model-keyword "") (eval `(defun ,(vhdl-function-name - "vhdl-model" model-name "hook") () + "vhdl-model" model-name "hook") + () (vhdl-hooked-abbrev ',(vhdl-function-name "vhdl-model" model-name))))) (setq model-alist (cdr model-alist))))) @@ -11837,7 +11852,7 @@ reflected in a subsequent paste operation." (defun vhdl-port-paste-context-clause (&optional exclude-pack-name) "Paste a context clause." - (let ((margin (current-indentation)) + (let (;; (margin (current-indentation)) (clause-list (nth 3 vhdl-port-list)) clause) (while clause-list @@ -11847,7 +11862,8 @@ reflected in a subsequent paste operation." (save-excursion (re-search-backward (concat "^\\s-*use\\s-+" (car clause) - "." (cdr clause) "\\>") nil t))) + "." (cdr clause) "\\>") + nil t))) (vhdl-template-standard-package (car clause) (cdr clause)) (insert "\n")) (setq clause-list (cdr clause-list))))) @@ -12239,7 +12255,8 @@ reflected in a subsequent paste operation." (cond ((and vhdl-include-direction-comments (nth 2 port)) (format "%-6s" (concat "[" (nth 2 port) "] "))) (vhdl-include-direction-comments " ")) - (when vhdl-include-port-comments (nth 4 port))) t)) + (when vhdl-include-port-comments (nth 4 port))) + t)) (setq port-list (cdr port-list)) (when port-list (insert "\n") (indent-to margin))) ;; align signal list @@ -12293,7 +12310,7 @@ reflected in a subsequent paste operation." (let ((case-fold-search t) (ent-name (vhdl-replace-string vhdl-testbench-entity-name (nth 0 vhdl-port-list))) - (source-buffer (current-buffer)) + ;; (source-buffer (current-buffer)) arch-name config-name ent-file-name arch-file-name ent-buffer arch-buffer position) ;; open entity file @@ -12794,7 +12811,7 @@ expressions (e.g. for index ranges of types and signals)." ;; override `he-list-beg' from `hippie-exp' (unless (and (boundp 'viper-mode) viper-mode) - (defalias 'he-list-beg 'vhdl-he-list-beg)) + (defalias 'he-list-beg #'vhdl-he-list-beg)) ;; function for expanding abbrevs and dabbrevs (defalias 'vhdl-expand-abbrev (make-hippie-expand-function @@ -12841,14 +12858,14 @@ expressions (e.g. for index ranges of types and signals)." (beginning-of-line) (yank)) -(defun vhdl-line-expand (&optional prefix-arg) +(defun vhdl-line-expand (&optional arg) "Hippie-expand current line." (interactive "P") (require 'hippie-exp) (let ((case-fold-search t) (case-replace nil) (hippie-expand-try-functions-list '(try-expand-line try-expand-line-all-buffers))) - (hippie-expand prefix-arg))) + (hippie-expand arg))) (defun vhdl-line-transpose-next (&optional arg) "Interchange this line with next line." @@ -12970,7 +12987,7 @@ File statistics: \"%s\"\n\ # total lines : %5d\n" (buffer-file-name) no-stats no-code-lines no-empty-lines no-comm-lines no-comments no-lines) - (unless vhdl-emacs-21 (vhdl-show-messages)))) + (when (featurep 'xemacs) (vhdl-show-messages)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Help functions @@ -13019,7 +13036,7 @@ File statistics: \"%s\"\n\ (customize-set-variable 'vhdl-project vhdl-project) (customize-save-customized)) -(defun vhdl-toggle-project (name token indent) +(defun vhdl-toggle-project (name _token _indent) "Set current project to NAME or unset if NAME is current project." (vhdl-set-project (if (equal name vhdl-project) "" name))) @@ -13223,6 +13240,7 @@ File statistics: \"%s\"\n\ "Toggle hideshow minor mode and update menu bar." (interactive "P") (require 'hideshow) + (declare-function hs-hide-all "hideshow" ()) ;; check for hideshow version 5.x (if (not (boundp 'hs-block-start-mdata-select)) (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") @@ -13234,8 +13252,8 @@ File statistics: \"%s\"\n\ hs-special-modes-alist))) (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) (if vhdl-hide-all-init - (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) - (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) + (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t) + (remove-hook 'hs-minor-mode-hook #'hs-hide-all t)) (hs-minor-mode arg) (force-mode-line-update))) ; hack to update menu bar @@ -13502,6 +13520,8 @@ This does background highlighting of translate-off regions.") (while syntax-alist (setq name (vhdl-function-name "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) + ;; FIXME: This `defvar' shouldn't be needed: just quote the face + ;; name when you use it. (eval `(defvar ,name ',name ,(concat "Face name to use for " (nth 0 (car syntax-alist)) "."))) @@ -13714,7 +13734,7 @@ This does background highlighting of translate-off regions.") (when (boundp 'ps-print-color-p) (vhdl-ps-print-settings)) (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) - (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) + (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -13886,7 +13906,7 @@ hierarchy otherwise.") pack-list pack-body-list inst-list inst-ent-list) ;; scan file (vhdl-visit-file - file-name nil + file-name nil (vhdl-prepare-search-2 (save-excursion ;; scan for design units @@ -14061,7 +14081,8 @@ hierarchy otherwise.") "component[ \t\n\r\f]+\\(\\w+\\)\\|" "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" "\\(\\(for\\|if\\)\\>[^;:]+\\\\|block\\>\\)\\)\\|" - "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) + "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") + end-of-unit t) (or (not limit-hier-inst-no) (<= (if (or (match-string 14) (match-string 16)) @@ -14423,12 +14444,15 @@ of PROJECT." ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker ;; comp-lib-name level) -(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key - conf-inst-alist level indent - &optional include-top ent-hier) +(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key + conf-key-arg conf-inst-alist level indent + &optional include-top ent-hier) "Get instantiation hierarchy beginning in architecture ARCH-KEY of entity ENT-KEY." - (let* ((ent-entry (vhdl-aget ent-alist ent-key)) + (let* ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (conf-key conf-key-arg) + (ent-entry (vhdl-aget ent-alist ent-key)) (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) (cdar (last (nth 3 ent-entry))))) (inst-alist (nth 3 arch-entry)) @@ -14560,6 +14584,8 @@ entity ENT-KEY." (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") (sit-for 2))))) +(defvar vhdl-cache-version) + (defun vhdl-save-cache (key) "Save current hierarchy cache to file." (let* ((orig-buffer (current-buffer)) @@ -14646,7 +14672,7 @@ entity ENT-KEY." (file-dir-name (expand-file-name file-name directory)) vhdl-cache-version) (unless (memq 'vhdl-save-caches kill-emacs-hook) - (add-hook 'kill-emacs-hook 'vhdl-save-caches)) + (add-hook 'kill-emacs-hook #'vhdl-save-caches)) (when (file-exists-p file-dir-name) (condition-case () (progn (load-file file-dir-name) @@ -14686,6 +14712,8 @@ if required." (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) (declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(declare-function speedbar-expand-line "speedbar" (&optional arg)) +(declare-function speedbar-edit-line "speedbar" ()) (defun vhdl-speedbar-initialize () "Initialize speedbar." @@ -14710,19 +14738,19 @@ if required." ;; keymap (unless vhdl-speedbar-mode-map (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) + (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches) (let ((key 0)) (while (<= key 9) (define-key vhdl-speedbar-mode-map (int-to-string key) @@ -14793,7 +14821,7 @@ if required." (setq speedbar-initial-expansion-list-name "vhdl directory")) (when (eq vhdl-speedbar-display-mode 'project) (setq speedbar-initial-expansion-list-name "vhdl project")) - (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) + (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy))) (defun vhdl-speedbar (&optional arg) "Open/close speedbar." @@ -14821,7 +14849,7 @@ if required." (declare-function speedbar-directory-buttons "speedbar" (directory _index)) (declare-function speedbar-file-lists "speedbar" (directory)) -(defun vhdl-speedbar-display-directory (directory depth &optional rescan) +(defun vhdl-speedbar-display-directory (directory depth &optional _rescan) "Display directory and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects nil) (setq speedbar-ignored-directory-regexp @@ -14842,7 +14870,7 @@ if required." (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) -(defun vhdl-speedbar-display-projects (project depth &optional rescan) +(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan) "Display projects and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects t) (setq speedbar-ignored-directory-regexp ".") @@ -14858,6 +14886,8 @@ if required." (declare-function speedbar-make-tag-line "speedbar" (type char func data tag tfunc tdata tface depth)) +(defvar vhdl-speedbar-update-current-unit) + (defun vhdl-speedbar-insert-projects () "Insert all projects in speedbar." (vhdl-speedbar-make-title-line "Projects:") @@ -14868,9 +14898,9 @@ if required." ;; insert projects (while project-alist (speedbar-make-tag-line - 'angle ?+ 'vhdl-speedbar-expand-project + 'angle ?+ #'vhdl-speedbar-expand-project (caar project-alist) (caar project-alist) - 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) + #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) (setq project-alist (cdr project-alist))) (setq project-alist vhdl-project-alist) ;; expand projects @@ -14917,12 +14947,14 @@ otherwise use cached data." (vhdl-speedbar-expand-units 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) +(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist + ent-inst-list depth) "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." (if (not (or ent-alist conf-alist pack-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) - (let (ent-entry conf-entry pack-entry) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + ent-entry conf-entry pack-entry) ;; insert entities (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) (while ent-alist @@ -14983,7 +15015,7 @@ otherwise use cached data." (declare-function speedbar-goto-this-file "speedbar" (file)) -(defun vhdl-speedbar-expand-dirs (directory) +(defun vhdl-speedbar-expand-dirs (_directory) "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." ;; (nicked from `speedbar-default-directory-list') @@ -15022,7 +15054,8 @@ otherwise use cached data." (goto-char position) (when (re-search-forward (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" - (car arch-alist) "\\>\\)") nil t) + (car arch-alist) "\\>\\)") + nil t) (beginning-of-line) (when (looking-at "^[0-9]+:\\s-*{") (goto-char (match-end 0)) @@ -15391,6 +15424,7 @@ otherwise use cached data." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Display help functions +;; FIXME: This `defvar' should be moved before its first use. (defvar vhdl-speedbar-update-current-unit t "Non-nil means to run `vhdl-speedbar-update-current-unit'.") @@ -15826,7 +15860,7 @@ NO-POSITION non-nil means do not re-position cursor." (abbreviate-file-name (file-name-as-directory (speedbar-line-directory indent))))) -(defun vhdl-speedbar-line-project (&optional indent) +(defun vhdl-speedbar-line-project (&optional _indent) "Get currently displayed project name." (and vhdl-speedbar-show-projects (save-excursion @@ -15896,7 +15930,7 @@ NO-POSITION non-nil means do not re-position cursor." ;; speedbar loads dframe at runtime. (declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) -(defun vhdl-speedbar-find-file (text token indent) +(defun vhdl-speedbar-find-file (_text token _indent) "When user clicks on TEXT, load file with name and position in TOKEN. Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file is already shown in a buffer." @@ -15924,12 +15958,12 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) - (end-of-line) - (if is-entity - (vhdl-port-copy) - (vhdl-subprog-copy))))) + (goto-char (point-min)) + (forward-line (1- (cdr token))) + (end-of-line) + (if is-entity + (vhdl-port-copy) + (vhdl-subprog-copy)))) (error (error "ERROR: %s not scanned successfully\n (%s)" (if is-entity "Port" "Interface") (cadr info)))) (error "ERROR: No entity/component or subprogram on current line"))))) @@ -16119,7 +16153,7 @@ expansion function)." ;; initialize speedbar (if (not (boundp 'speedbar-frame)) - (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)) + (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize)) (vhdl-speedbar-initialize) (when speedbar-frame (vhdl-speedbar-refresh))) @@ -16147,7 +16181,7 @@ expansion function)." (read-from-minibuffer "architecture name: " nil vhdl-minibuffer-local-map) (vhdl-replace-string vhdl-compose-architecture-name ent-name))) - ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) + ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project (message "Creating component \"%s(%s)\"..." ent-name arch-name) ;; open entity file (unless (eq vhdl-compose-create-files 'none) @@ -16347,7 +16381,7 @@ component instantiation." (if comp-name ;; ... from component declaration (vhdl-visit-file - (when vhdl-use-components-package pack-file-name) t + (when vhdl-use-components-package pack-file-name) t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) @@ -16358,7 +16392,7 @@ component instantiation." (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) "." (file-name-extension (buffer-file-name)))) (vhdl-visit-file - comp-ent-file-name t + comp-ent-file-name t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) @@ -16631,6 +16665,8 @@ component instantiation." (vhdl-comment-insert-inline (nth 4 entry) t)) (insert "\n")) +(defvar lazy-lock-minimum-size) + (defun vhdl-compose-components-package () "Generate a package containing component declarations for all entities in the current project/directory." @@ -16683,10 +16719,10 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) - (end-of-line) - (vhdl-port-copy))) + (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) + (end-of-line) + (vhdl-port-copy)) (goto-char component-pos) (vhdl-port-paste-component t) (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) @@ -16700,13 +16736,16 @@ current project/directory." (message "Generating components package \"%s\"...done\n File created: \"%s\"" pack-name pack-file-name))) -(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist - conf-alist inst-alist - &optional insert-conf) +(defun vhdl-compose-configuration-architecture ( _ent-name arch-name + ent-alist-arg conf-alist-arg + inst-alist + &optional insert-conf) "Generate block configuration for architecture." - (let ((margin (current-indentation)) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (margin (current-indentation)) (beg (point-at-bol)) - ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) + ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key ;; insert block configuration (for architecture) (vhdl-insert-keyword "FOR ") (insert arch-name "\n") (setq margin (+ margin vhdl-basic-offset)) @@ -17057,7 +17096,7 @@ do not print any file names." (file-relative-name (buffer-file-name)))) (when (and (= 0 (nth 1 (nth 10 compiler))) (= 0 (nth 1 (nth 11 compiler)))) - (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) + (setq compilation-process-setup-function #'vhdl-compile-print-file-name)) ;; run compilation (if options (when command @@ -17131,7 +17170,7 @@ specified by a target." vhdl-error-regexp-emacs-alist))) (when vhdl-emacs-22 - (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -17410,7 +17449,7 @@ specified by a target." (setq tmp-list rule-alist) (while tmp-list ; pre-sort rule targets (setq cell (cdar tmp-list)) - (setcar cell (sort (car cell) 'string<)) + (setcar cell (sort (car cell) #'string<)) (setq tmp-list (cdr tmp-list))) (setq rule-alist ; sort by first rule target (sort rule-alist @@ -17500,9 +17539,9 @@ specified by a target." ;; insert rule for each library unit (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") (while prim-list - (setq second-list (sort (nth 1 (car prim-list)) 'string<)) + (setq second-list (sort (nth 1 (car prim-list)) #'string<)) (setq subcomp-list - (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) + (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<)) (setq unit-key (caar prim-list) unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) (nth 0 (vhdl-aget conf-alist unit-key)) @@ -17532,7 +17571,7 @@ specified by a target." (vhdl-get-compile-options project compiler (nth 0 rule) t)) ;; insert rule if file is supposed to be compiled (setq target-list (nth 1 rule) - depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) + depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<)) ;; insert targets (setq tmp-list target-list) (while target-list @@ -17555,7 +17594,8 @@ specified by a target." (if (eq options 'default) "$(OPTIONS)" options) " " (nth 0 rule) (if (equal vhdl-compile-post-command "") "" - " $(POST-COMPILE)") "\n") + " $(POST-COMPILE)") + "\n") (insert "\n")) (unless (and options mapping-exist) (setq tmp-list target-list) @@ -17595,6 +17635,7 @@ specified by a target." "Submit via mail a bug report on VHDL Mode." (interactive) ;; load in reporter + (defvar reporter-prompt-for-summary-p) (and (y-or-n-p "Do you want to submit a report on VHDL Mode? ") (let ((reporter-prompt-for-summary-p t))