diff options
Diffstat (limited to 'lisp/progmodes')
61 files changed, 3345 insertions, 3250 deletions
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index bf56a7ee49e..24e1f8831a0 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -695,7 +695,7 @@ imenu." (define-key map "\e\C-e" 'antlr-end-of-rule) (define-key map "\C-c\C-a" 'antlr-beginning-of-body) (define-key map "\C-c\C-e" 'antlr-end-of-body) - (define-key map "\C-c\C-f" 'c-forward-into-nomenclature) + (define-key map "\C-c\C-f" 'subword-forward) (define-key map "\C-c\C-b" 'c-backward-into-nomenclature) (define-key map "\C-c\C-c" 'comment-region) (define-key map "\C-c\C-v" 'antlr-hide-actions) @@ -745,7 +745,7 @@ imenu." ["Backward Statement" c-beginning-of-statement t] ["Forward Statement" c-end-of-statement t] ["Backward Into Nomencl." c-backward-into-nomenclature t] - ["Forward Into Nomencl." c-forward-into-nomenclature t]) + ["Forward Into Nomencl." subword-forward t]) ["Indent Region" indent-region :active (and (not buffer-read-only) (c-region-is-active-p))] ["Comment Out Region" comment-region diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 5d5811b47d1..d12bed7e27d 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -1,4 +1,4 @@ -;;; autoconf.el --- mode for editing Autoconf configure.ac files +;;; autoconf.el --- mode for editing Autoconf configure.ac files -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 75ebc29710c..c52331f84fa 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -72,7 +72,7 @@ so that it is considered safe, see `enable-local-variables'.") "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" "Regular expression matching bug references. The second subexpression should match the bug reference (usually a number)." - :type 'string + :type 'regexp :version "24.3" ; previously defconst :group 'bug-reference) @@ -139,12 +139,312 @@ The second subexpression should match the bug reference (usually a number)." (when url (browse-url url)))))) +(defun bug-reference--maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt) + (when (string-match url-rx url) + (setq-local bug-reference-bug-regexp bug-rx) + (setq-local bug-reference-url-format + (let (groups) + (dotimes (i (/ (length (match-data)) 2)) + (push (match-string i url) groups)) + (funcall bug-url-fmt (nreverse groups)))))) + +(defvar bug-reference-setup-from-vc-alist + `(;; + ;; GNU projects on savannah. + ;; + ;; Not all of them use debbugs but that doesn't really matter + ;; because the auto-setup is only performed if + ;; `bug-reference-url-format' and `bug-reference-bug-regexp' + ;; aren't set already. + ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" + "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>" + ,(lambda (_) "https://debbugs.gnu.org/%s")) + ;; + ;; GitHub projects. + ;; + ;; Here #17 may refer to either an issue or a pull request but + ;; visiting the issue/17 web page will automatically redirect to + ;; the pull/17 page if 17 is a PR. Explicit user/project#17 links + ;; to possibly different projects are also supported. + ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" + "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (concat "https://github.com/" + (or + ;; Explicit user/proj#18 link. + (match-string 1) + ns-project) + "/issues/" + (match-string 2)))))) + ;; + ;; GitLab projects. + ;; + ;; Here #18 is an issue and !17 is a merge request. Explicit + ;; namespace/project#18 or namespace/project!17 references to + ;; possibly different projects are also supported. + ("[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" + "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (concat "https://gitlab.com/" + (or (match-string 1) + ns-project) + "/-/" + (if (string= (match-string 3) "#") + "issues/" + "merge_requests/") + (match-string 2))))))) + "An alist for setting up `bug-reference-mode' based on VC URL. + +Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN). + +URL-REGEXP is matched against the version control URL of the +current buffer's file. If it matches, BUG-REGEXP is set as +`bug-reference-bug-regexp'. URL-FORMAT-FN is a function of one +argument that receives a list of the groups 0 to N of matching +URL-REGEXP against the VCS URL and returns the value to be set as +`bug-reference-url-format'.") + +(defun bug-reference-try-setup-from-vc () + "Try setting up `bug-reference-mode' based on VC information. +Test each configuration in `bug-reference-setup-from-vc-alist' +and apply it if applicable." + (let ((file-or-dir (or buffer-file-name + ;; Catches modes such as vc-dir and Magit. + default-directory))) + (when file-or-dir + (let* ((backend (vc-responsible-backend file-or-dir t)) + (url + (or (ignore-errors + (vc-call-backend backend 'repository-url "upstream")) + (ignore-errors + (vc-call-backend backend 'repository-url))))) + (when url + (catch 'found + (dolist (config bug-reference-setup-from-vc-alist) + (when (apply #'bug-reference--maybe-setup-from-vc + url config) + (throw 'found t))))))))) + +(defvar bug-reference-setup-from-mail-alist + `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words) + ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org" + ;; List-Id of Gnus devel mailing list. + "ding.gnus.org")) + "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "https://debbugs.gnu.org/%s")) + "An alist for setting up `bug-reference-mode' in mail modes. + +This takes action if `bug-reference-mode' is enabled in group and +message buffers of Emacs mail clients. Currently, only Gnus is +supported. + +Each element has the form + + (GROUP-REGEXP HEADER-REGEXP BUG-REGEXP URL-FORMAT) + +GROUP-REGEXP is a regexp matched against the current mail folder +or newsgroup name. HEADER-REGEXP is a regexp matched against the +From, To, Cc, Newsgroup, and List-ID header values of the current +mail or newsgroup message. If any of those matches, BUG-REGEXP +is set as `bug-reference-bug-regexp' and URL-FORMAT is set as +`bug-reference-url-format'. + +Note: In Gnus, if a summary buffer has been set up based on +GROUP-REGEXP, all article buffers opened from there will get the +same `bug-reference-url-format' and `bug-reference-url-format'.") + +(defvar gnus-newsgroup-name) + +(defun bug-reference--maybe-setup-from-mail (group header-values) + "Set up according to mail GROUP or HEADER-VALUES. +Group is a mail group/folder name and HEADER-VALUES is a list of +mail header values, e.g., the values of From, To, Cc, List-ID, +and Newsgroup. + +If any GROUP-REGEXP or HEADER-REGEXP of +`bug-reference-setup-from-mail-alist' matches GROUP or any +element in HEADER-VALUES, the corresponding BUG-REGEXP and +URL-FORMAT are set." + (catch 'setup-done + (dolist (config bug-reference-setup-from-mail-alist) + (when (or + (and group + (car config) + (string-match-p (car config) group)) + (and header-values + (nth 1 config) + (catch 'matching-header + (dolist (h header-values) + (when (and h (string-match-p (nth 1 config) h)) + (throw 'matching-header t)))))) + (setq-local bug-reference-bug-regexp (nth 2 config)) + (setq-local bug-reference-url-format (nth 3 config)) + (throw 'setup-done t))))) + +(defun bug-reference-try-setup-from-gnus () + "Try setting up `bug-reference-mode' based on Gnus group or article. +Test each configuration in `bug-reference-setup-from-mail-alist' +and set it if applicable." + (when (and (derived-mode-p 'gnus-summary-mode) + (bound-and-true-p gnus-newsgroup-name)) + ;; Gnus reuses its article buffer so we have to check whenever the + ;; article changes. + (add-hook 'gnus-article-prepare-hook + #'bug-reference--try-setup-gnus-article) + (bug-reference--maybe-setup-from-mail gnus-newsgroup-name nil))) + +(defvar gnus-article-buffer) +(defvar gnus-original-article-buffer) +(defvar gnus-summary-buffer) + +(defun bug-reference--try-setup-gnus-article () + (with-demoted-errors + "Error in bug-reference--try-setup-gnus-article: %S" + (when (and bug-reference-mode ;; Only if enabled in article buffers. + (derived-mode-p + 'gnus-article-mode + ;; Apparently, gnus-article-prepare-hook is run in the + ;; summary buffer... + 'gnus-summary-mode) + gnus-article-buffer + gnus-original-article-buffer + (buffer-live-p (get-buffer gnus-article-buffer)) + (buffer-live-p (get-buffer gnus-original-article-buffer))) + (with-current-buffer gnus-article-buffer + (catch 'setup-done + ;; Copy over the values from the summary buffer. + (when (and gnus-summary-buffer + (buffer-live-p gnus-summary-buffer)) + (setq-local bug-reference-bug-regexp + (with-current-buffer gnus-summary-buffer + bug-reference-bug-regexp)) + (setq-local bug-reference-url-format + (with-current-buffer gnus-summary-buffer + bug-reference-url-format)) + (when (and bug-reference-bug-regexp + bug-reference-url-format) + (throw 'setup-done t))) + ;; If the summary had no values, try setting according to + ;; the values of the From, To, and Cc headers. + (let (header-values) + (with-current-buffer + (get-buffer gnus-original-article-buffer) + (save-excursion + (goto-char (point-min)) + ;; The Newsgroup is omitted because we already matched + ;; based on group name in the summary buffer. + (dolist (field '("list-id" "to" "from" "cc")) + (let ((val (mail-fetch-field field))) + (when val + (push val header-values)))))) + (bug-reference--maybe-setup-from-mail nil header-values))))))) + +(defvar bug-reference-setup-from-irc-alist + `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" + "erc") 'words)) + "freenode" + "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "https://debbugs.gnu.org/%s")) + "An alist for setting up `bug-reference-mode' in IRC modes. + +This takes action if `bug-reference-mode' is enabled in IRC +channels using one of Emacs' IRC clients (rcirc and ERC). +Currently, rcirc and ERC are supported. + +Each element has the form + + (CHANNEL-REGEXP NETWORK-REGEXP BUG-REGEXP URL-FORMAT) + +CHANNEL-REGEXP is a regexp matched against the current IRC +channel name (e.g. #emacs). NETWORK-REGEXP is matched against +the IRC network name (e.g. freenode). Both entries are optional. +If all given entries match, BUG-REGEXP is set as +`bug-reference-bug-regexp' and URL-FORMAT is set as +`bug-reference-url-format'.") + +(defun bug-reference--maybe-setup-from-irc (channel network) + "Set up according to IRC CHANNEL or NETWORK. +CHANNEL is an IRC channel name (or generally a target, i.e., it +could also be a user name) and NETWORK is that channel's network +name. + +If any `bug-reference-setup-from-irc-alist' entry's +CHANNEL-REGEXP and NETWORK-REGEXP match CHANNEL and NETWORK, the +corresponding BUG-REGEXP and URL-FORMAT are set." + (catch 'setup-done + (dolist (config bug-reference-setup-from-irc-alist) + (let ((channel-rx (car config)) + (network-rx (nth 1 config))) + (when (and + ;; One of both has to be given. + (or channel-rx network-rx) + ;; The args have to be set. + channel network) + (when (and + (or (null channel-rx) + (string-match-p channel-rx channel)) + (or (null network-rx) + (string-match-p network-rx network))) + (setq-local bug-reference-bug-regexp (nth 2 config)) + (setq-local bug-reference-url-format (nth 3 config)) + (throw 'setup-done t))))))) + +(defvar rcirc-target) +(defvar rcirc-server-buffer) +(defvar rcirc-server) + +(defun bug-reference-try-setup-from-rcirc () + "Try setting up `bug-reference-mode' based on rcirc channel and server. +Test each configuration in `bug-reference-setup-from-irc-alist' +and set it if applicable." + (when (derived-mode-p 'rcirc-mode) + (bug-reference--maybe-setup-from-irc + rcirc-target + (and rcirc-server-buffer + (buffer-live-p rcirc-server-buffer) + (with-current-buffer rcirc-server-buffer + rcirc-server))))) + +(declare-function erc-format-target "erc") +(declare-function erc-network-name "erc-networks") + +(defun bug-reference-try-setup-from-erc () + "Try setting up `bug-reference-mode' based on ERC channel and server. +Test each configuration in `bug-reference-setup-from-irc-alist' +and set it if applicable." + (when (derived-mode-p 'erc-mode) + (bug-reference--maybe-setup-from-irc + (erc-format-target) + (erc-network-name)))) + +(defun bug-reference--run-auto-setup () + (when (or bug-reference-mode + bug-reference-prog-mode) + ;; Automatic setup only if the variables aren't already set, e.g., + ;; by a local variables section in the file. + (unless (and bug-reference-bug-regexp + bug-reference-url-format) + (with-demoted-errors + "Error during bug-reference auto-setup: %S" + (catch 'setup + (dolist (f (list #'bug-reference-try-setup-from-vc + #'bug-reference-try-setup-from-gnus + #'bug-reference-try-setup-from-rcirc + #'bug-reference-try-setup-from-erc)) + (when (funcall f) + (throw 'setup t)))))))) + ;;;###autoload (define-minor-mode bug-reference-mode "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." nil "" nil + :after-hook (bug-reference--run-auto-setup) (if bug-reference-mode (jit-lock-register #'bug-reference-fontify) (jit-lock-unregister #'bug-reference-fontify) @@ -158,6 +458,7 @@ The second subexpression should match the bug reference (usually a number)." nil "" nil + :after-hook (bug-reference--run-auto-setup) (if bug-reference-prog-mode (jit-lock-register #'bug-reference-fontify) (jit-lock-unregister #'bug-reference-fontify) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index f30477dc787..6172afecbcf 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -790,6 +790,38 @@ arglist-cont-nonempty." (or (c-lineup-assignments langelem) c-basic-offset)) +(defun c-lineup-ternary-bodies (langelem) + "Line up true and false branches of a ternary operator (i.e. `?:'). +More precisely, if the line starts with a colon which is a part of +a said operator, align it with corresponding question mark; otherwise +return nil. For example: + + return arg % 2 == 0 ? arg / 2 + : (3 * arg + 1); <- c-lineup-ternary-bodies + +Works with: arglist-cont, arglist-cont-nonempty and statement-cont." + (save-excursion + (back-to-indentation) + (when (and (eq ?: (char-after)) + (not (eq ?: (char-after (1+ (point)))))) + (let ((limit (c-langelem-pos langelem)) (depth 1)) + (catch 'done + (while (and (c-syntactic-skip-backward "^?:" limit t) + (not (bobp))) + (backward-char) + (cond ((eq (char-after) ??) + ;; If we've found a question mark, decrease depth. If we've + ;; reached zero, we've found the one we were looking for. + (when (zerop (setq depth (1- depth))) + (throw 'done (vector (current-column))))) + ((or (eq ?: (char-before)) (eq ?? (char-before))) + ;; Step over `::' and `?:' operators. We don't have to + ;; handle `?:' here but doing so saves an iteration. + (if (eq (point) limit) + (throw 'done nil) + (goto-char (1- (point))))) + ((setq depth (1+ depth)))))))))) ; Otherwise increase depth. + (defun c-lineup-cascaded-calls (langelem) "Line up \"cascaded calls\" under each other. If the line begins with \"->\" or \".\" and the preceding line ends diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index fd61e3e3287..52e6da6f4ac 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1003,7 +1003,7 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ ;; Matches an unterminated string/regexp, NOT including the eol at the end. (defconst c-awk-harmless-pattern-characters* - (concat "\\([^{;#/\"\\\\\n\r]\\|" c-awk-esc-pair-re "\\)*")) + (concat "\\([^{;#/\"\\\n\r]\\|" c-awk-esc-pair-re "\\)*")) ;; Matches any "harmless" character in a pattern or an escaped character pair. (defun c-awk-at-statement-end-p () diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 1071191775b..4425e275ac9 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -48,6 +48,7 @@ (cc-bytecomp-defvar filladapt-mode) ; c-fill-paragraph contains a kludge ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) +(cc-bytecomp-defvar c-indent-to-body-directives) ;; Indentation / Display syntax functions (defvar c-fix-backslashes t) @@ -512,11 +513,11 @@ function to control that." (let ((src (default-value 'post-self-insert-hook))) (while src (unless (memq (car src) c--unsafe-post-self-insert-hook-functions) - (add-hook 'dest (car src) t)) ; Preserve the order of the functions. + (push (car src) dest)) (setq src (cdr src))))) - (t (add-hook 'dest (car src) t))) ; Preserve the order of the functions. + (t (push (car src) dest))) (setq src (cdr src))) - (run-hooks 'dest))) + (mapc #'funcall (nreverse dest)))) ; Preserve the order of the functions. (defmacro c--call-post-self-insert-hook-more-safely () ;; Call post-self-insert-hook, if such exists. See comment for @@ -1441,6 +1442,98 @@ keyword on the line, the keyword is not inserted inside a literal, and (indent-according-to-mode) (delete-char -2))))) +(defun c-align-cpp-indent-to-body () + "Align a \"#pragma\" line under the previous line. +This function is intented for use as a member of `c-special-indent-hook'." + (when (assq 'cpp-macro c-syntactic-context) + (when + (save-excursion + (save-match-data + (back-to-indentation) + (and + (looking-at (concat c-opt-cpp-symbol "[ \t]*\\([a-zA-Z0-9_]+\\)")) + (member (match-string-no-properties 1) + c-cpp-indent-to-body-directives)))) + (c-indent-line (delete '(cpp-macro) c-syntactic-context))))) + +(defvar c-cpp-indent-to-body-flag nil) +;; Non-nil when CPP directives such as "#pragma" should be indented to under +;; the preceding statement. +(make-variable-buffer-local 'c-cpp-indent-to-body-flag) + +(defun c-electric-pragma () + "Reindent the current line if appropriate. + +This function is used to reindent a preprocessor line when the +symbol for the directive, typically \"pragma\", triggers this +function as a hook function of an abbreviation. + +The \"#\" of the preprocessor construct is aligned under the +first anchor point of the line's syntactic context. + +The line is reindented if the construct is not in a string or +comment, there is exactly one \"#\" contained in optional +whitespace before it on the current line, and `c-electric-flag' +and `c-syntactic-indentation' are both non-nil." + (save-excursion + (save-match-data + (when + (and + c-cpp-indent-to-body-flag + c-electric-flag + c-syntactic-indentation + last-abbrev-location + c-opt-cpp-symbol ; "#" or nil. + (progn (back-to-indentation) + (looking-at (concat c-opt-cpp-symbol "[ \t]*"))) + (>= (match-end 0) last-abbrev-location) + (not (c-literal-limits))) + (c-indent-line (delete '(cpp-macro) (c-guess-basic-syntax))))))) + +(defun c-add-indent-to-body-to-abbrev-table (d) + ;; Create an abbreviation table entry for the directive D, and add it to the + ;; current abbreviation table. Existing abbreviation (e.g. for "else") do + ;; not get overwritten. + (when (and c-buffer-is-cc-mode + local-abbrev-table + (not (abbrev-symbol d local-abbrev-table))) + (condition-case nil + (define-abbrev local-abbrev-table d d 'c-electric-pragma 0 t) + (wrong-number-of-arguments + (define-abbrev local-abbrev-table d d 'c-electric-pragma))))) + +(defun c-clear-stale-indent-to-body-abbrevs () + ;; Fill in this comment. FIXME!!! + (when (fboundp 'abbrev-get) + (mapatoms (lambda (a) + (when (and (abbrev-get a ':system) ; Preserve a user's abbrev! + (not (member (symbol-name a) c-std-abbrev-keywords)) + (not (member (symbol-name a) + c-cpp-indent-to-body-directives))) + (unintern a local-abbrev-table))) + local-abbrev-table))) + +(defun c-toggle-cpp-indent-to-body (&optional arg) + "Toggle the C preprocessor indent-to-body feature. +When enabled, preprocessor directives which are words in +`c-indent-to-body-directives' are indented as if they were statements. + +Optional numeric ARG, if supplied, turns on the feature when positive, +turns it off when negative, and just toggles it when zero or +left out." + (interactive "P") + (setq c-cpp-indent-to-body-flag + (c-calculate-state arg c-cpp-indent-to-body-flag)) + (if c-cpp-indent-to-body-flag + (progn + (c-clear-stale-indent-to-body-abbrevs) + (mapc 'c-add-indent-to-body-to-abbrev-table + c-cpp-indent-to-body-directives) + (add-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body nil t)) + (remove-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body t)) + (message "c-cpp-indent-to-body %sabled" + (if c-cpp-indent-to-body-flag "en" "dis"))) + (declare-function subword-forward "subword" (&optional arg)) @@ -1461,19 +1554,6 @@ keyword on the line, the keyword is not inserted inside a literal, and (declare-function c-backward-subword "ext:cc-subword" (&optional arg)) ;; "nomenclature" functions + c-scope-operator. -(defun c-forward-into-nomenclature (&optional arg) - "Compatibility alias for `c-forward-subword'." - (interactive "p") - (if (fboundp 'subword-mode) - (progn - (require 'subword) - (subword-forward arg)) - (require 'cc-subword) - (c-forward-subword arg))) -(make-obsolete 'c-forward-into-nomenclature - (if (fboundp 'subword-mode) 'subword-forward 'c-forward-subword) - "23.2") - (defun c-backward-into-nomenclature (&optional arg) "Compatibility alias for `c-backward-subword'." (interactive "p") @@ -2024,6 +2104,23 @@ other top level construct with a brace block." (c-backward-syntactic-ws) (point)))) + ((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method + ;; Move to the beginning of the method name. + (c-forward-token-2 2 t) + (let* ((class + (save-excursion + (when (re-search-backward + "^\\s-*@\\(implementation\\|class\\|interface\\)\\s-+\\(\\sw+\\)" nil t) + (match-string-no-properties 2)))) + (limit (save-excursion (re-search-forward "[;{]" nil t))) + (method (when (re-search-forward "\\(\\sw+:?\\)" limit t) + (match-string-no-properties 1)))) + (when (and class method) + ;; Add the parameter labels onto name. They always end in ':'. + (while (re-search-forward "\\(\\sw+:\\)" limit 1) + (setq method (concat method (match-string-no-properties 1)))) + (concat "[" class " " method "]")))) + (t ; Normal function or initializer. (when (looking-at c-defun-type-name-decl-key) ; struct, etc. (goto-char (match-end 0)) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index a1e3a236a11..9a3d7adf61d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -87,7 +87,7 @@ ;;; Variables also used at compile time. -(defconst c-version "5.34.1" +(defconst c-version "5.34.2" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -445,6 +445,15 @@ to it is returned. This function does not modify the point or the mark." ;; Emacs and earlier XEmacs `(next-single-property-change ,position ,prop ,object ,limit))) +(defmacro c-previous-single-property-change (position prop &optional object limit) + ;; See the doc string for either of the defuns expanded to. + (if (and c-use-extents + (fboundp 'previous-single-char-property-change)) + ;; XEmacs >= 2005-01-25 + `(previous-single-char-property-change ,position ,prop ,object ,limit) + ;; Emacs and earlier XEmacs + `(previous-single-property-change ,position ,prop ,object ,limit))) + (defmacro c-region-is-active-p () ;; Return t when the region is active. The determination of region ;; activeness is different in both Emacs and XEmacs. @@ -1047,15 +1056,6 @@ MODE is either a mode symbol or a list of mode symbols." ;; properties set on a single character and that never spread to any ;; other characters. -(defmacro c-put-syn-tab (pos value) - ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to - ;; VALUE (which should not be nil). - `(let ((-pos- ,pos) - (-value- ,value)) - (c-put-char-property -pos- 'syntax-table -value-) - (c-put-char-property -pos- 'c-fl-syn-tab -value-) - (c-truncate-lit-pos-cache -pos-))) - (eval-and-compile ;; Constant used at compile time to decide whether or not to use ;; XEmacs extents. Check all the extent functions we'll use since @@ -1183,13 +1183,6 @@ MODE is either a mode symbol or a list of mode symbols." ;; Emacs < 21. `(c-clear-char-property-fun ,pos ',property)))) -(defmacro c-clear-syn-tab (pos) - ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS. - `(let ((-pos- ,pos)) - (c-clear-char-property -pos- 'syntax-table) - (c-clear-char-property -pos- 'c-fl-syn-tab) - (c-truncate-lit-pos-cache -pos-))) - (defmacro c-min-property-position (from to property) ;; Return the first position in the range [FROM to) where the text property ;; PROPERTY is set, or `most-positive-fixnum' if there is no such position. @@ -1235,8 +1228,18 @@ MODE is either a mode symbol or a list of mode symbols." ;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text ;; properties between FROM and TO. `(let ((-from- ,from) (-to- ,to)) - (c-clear-char-properties -from- -to- 'syntax-table) - (c-clear-char-properties -from- -to- 'c-fl-syn-tab))) + (when (and + c-min-syn-tab-mkr c-max-syn-tab-mkr + (< -from- c-max-syn-tab-mkr) + (> -to- c-min-syn-tab-mkr)) + (let ((pos -from-)) + (while (and + (< pos -to-) + (setq pos (c-min-property-position pos -to- 'c-fl-syn-tab)) + (< pos -to-)) + (c-clear-syn-tab pos) + (setq pos (1+ pos))))) + (c-clear-char-properties -from- -to- 'syntax-table))) (defmacro c-search-forward-char-property (property value &optional limit) "Search forward for a text-property PROPERTY having value VALUE. @@ -1456,28 +1459,6 @@ with value CHAR in the region [FROM to)." (c-put-char-property (point) ,property ,value) (forward-char))))) -(defmacro c-with-extended-string-fences (beg end &rest body) - ;; If needed, extend the region with "mirrored" c-fl-syn-tab properties to - ;; contain the region (BEG END), then evaluate BODY. If this mirrored - ;; region was initially empty, restore it afterwards. - `(let ((-beg- ,beg) - (-end- ,end) - ) - (cond - ((null c-fl-syn-tab-region) - (unwind-protect - (progn - (c-restore-string-fences -beg- -end-) - ,@body) - (c-clear-string-fences))) - ((and (>= -beg- (car c-fl-syn-tab-region)) - (<= -end- (cdr c-fl-syn-tab-region))) - ,@body) - (t ; Crudely extend the mirrored region. - (setq -beg- (min -beg- (car c-fl-syn-tab-region)) - -end- (max -end- (cdr c-fl-syn-tab-region))) - (c-restore-string-fences -beg- -end-) - ,@body)))) ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. ;; For our purposes, these are characterized by being possible to diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 34490d1356a..7b8b174c430 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -163,7 +163,9 @@ (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) -(defvar c-fl-syn-tab-region) +(cc-bytecomp-defvar c-min-syn-tab-mkr) +(cc-bytecomp-defvar c-max-syn-tab-mkr) +(cc-bytecomp-defun c-clear-syn-tab) (cc-bytecomp-defun c-clear-string-fences) (cc-bytecomp-defun c-restore-string-fences) @@ -405,7 +407,7 @@ comment at the start of cc-engine.el for more info." (when (and (car c-macro-cache) (> (point) (car c-macro-cache)) ; in case we have a ; zero-sized region. - (not (eq (char-before (1- (point))) ?\\))) + (not lim)) (setcdr c-macro-cache (point)) (setq c-macro-cache-syntactic nil))))))) @@ -1580,6 +1582,7 @@ comment at the start of cc-engine.el for more info." (save-excursion (backward-char) (looking-at "\\s(")) (c-crosses-statement-barrier-p (point) end))))) +(make-obsolete 'c-at-expression-start-p nil "CC mode 5.35") ;; A set of functions that covers various idiosyncrasies in @@ -1642,6 +1645,21 @@ comment at the start of cc-engine.el for more info." (forward-char 2) t)))) +(defmacro c-forward-comment-minus-1 () + "Call (forward-comment -1), taking care of escaped newlines. +Return the result of `forward-comment' if it gets called, nil otherwise." + `(if (not comment-end-can-be-escaped) + (forward-comment -1) + (when (and (< (skip-syntax-backward " >") 0) + (eq (char-after) ?\n)) + (forward-char)) + (cond + ((and (eq (char-before) ?\n) + (eq (char-before (1- (point))) ?\\)) + (backward-char) + nil) + (t (forward-comment -1))))) + (defun c-backward-single-comment () "Move backward past whitespace and the closest preceding comment, if any. Return t if a comment was found, nil otherwise. In either case, the @@ -1675,12 +1693,12 @@ This function does not do any hidden buffer changes." ;; same line. (re-search-forward "\\=\\s *[\n\r]" start t) - (if (if (forward-comment -1) + (if (if (c-forward-comment-minus-1) (if (eolp) ;; If forward-comment above succeeded and we're at eol ;; then the newline we moved over above didn't end a ;; line comment, so we give it another go. - (forward-comment -1) + (c-forward-comment-minus-1) t)) ;; Emacs <= 20 and XEmacs move back over the closer of a @@ -1709,7 +1727,7 @@ comment at the start of cc-engine.el for more info." (if (let (moved-comment) (while - (and (not (setq moved-comment (forward-comment -1))) + (and (not (setq moved-comment (c-forward-comment-minus-1))) ;; Cope specifically with ^M^J here - ;; forward-comment sometimes gets stuck after ^Ms, ;; sometimes after ^M^J. @@ -1895,52 +1913,29 @@ comment at the start of cc-engine.el for more info." (defun c-enclosing-c++-attribute () ;; If we're in C++ Mode, and point is within a correctly balanced [[ ... ]] ;; attribute structure, return a cons of its starting and ending positions. - ;; Otherwise, return nil. We use the c-{in,is}-sws-face text properties for - ;; this determination, this macro being intended only for use in the *-sws-* - ;; functions and macros. The match data are NOT preserved over this macro. - (let (attr-end pos-is-sws) - (and - (c-major-mode-is 'c++-mode) - (> (point) (point-min)) - (setq pos-is-sws - (if (get-text-property (1- (point)) 'c-is-sws) - (1- (point)) - (1- (previous-single-property-change - (point) 'c-is-sws nil (point-min))))) - (save-excursion - (goto-char pos-is-sws) - (setq attr-end (c-looking-at-c++-attribute))) - (> attr-end (point)) - (cons pos-is-sws attr-end)))) - -(defun c-slow-enclosing-c++-attribute () - ;; Like `c-enclosing-c++-attribute', but does not depend on the c-i[ns]-sws - ;; properties being set. + ;; Otherwise, return nil. (and (c-major-mode-is 'c++-mode) (save-excursion - (let ((paren-state (c-parse-state)) + (let ((lim (max (- (point) 200) (point-min))) cand) (while - (progn - (setq cand - (catch 'found-cand - (while (cdr paren-state) - (when (and (numberp (car paren-state)) - (numberp (cadr paren-state)) - (eq (car paren-state) - (1+ (cadr paren-state))) - (eq (char-after (car paren-state)) ?\[) - (eq (char-after (cadr paren-state)) ?\[)) - (throw 'found-cand (cadr paren-state))) - (setq paren-state (cdr paren-state))))) - (and cand - (not - (and (c-go-list-forward cand) - (eq (char-before) ?\]) - (eq (char-before (1- (point))) ?\]))))) - (setq paren-state (cdr paren-state))) - (and cand (cons cand (point))))))) + (and + (progn + (skip-chars-backward "^[;{}" lim) + (eq (char-before) ?\[)) + (not (eq (char-before (1- (point))) ?\[)) + (> (point) lim)) + (backward-char)) + (and (eq (char-before) ?\[) + (eq (char-before (1- (point))) ?\[) + (progn (backward-char 2) t) + (setq cand (point)) + (c-go-list-forward nil (min (+ (point) 200) (point-max))) + (eq (char-before) ?\]) + (eq (char-before (1- (point))) ?\]) + (not (c-literal-limits)) + (cons cand (point))))))) (defun c-invalidate-sws-region-before (beg end) ;; Called from c-before-change. BEG and END are the bounds of the change @@ -2988,9 +2983,7 @@ comment at the start of cc-engine.el for more info." c-block-comment-awkward-chars))) (and (nth 4 s) (nth 7 s) ; Line comment (not (memq (char-before here) '(?\\ ?\n))))))) - (c-with-extended-string-fences - pos here - (setq s (parse-partial-sexp pos here nil nil s)))) + (setq s (parse-partial-sexp pos here nil nil s))) (when (not (eq near-pos here)) (c-semi-put-near-cache-entry here s)) (cond @@ -3122,7 +3115,7 @@ comment at the start of cc-engine.el for more info." (not base) ; FIXME!!! Compare base and far-base?? ; (2019-05-21) (not end) - (> here end)) + (>= here end)) (progn (setq far-base-and-state (c-parse-ps-state-below here) far-base (car far-base-and-state) @@ -3135,7 +3128,7 @@ comment at the start of cc-engine.el for more info." (or (and (> here base) (null end)) (null (nth 8 s)) - (and end (> here end)) + (and end (>= here end)) (not (or (and (nth 3 s) ; string @@ -3194,6 +3187,24 @@ comment at the start of cc-engine.el for more info." c-semi-near-cache-limit (min c-semi-near-cache-limit pos) c-full-near-cache-limit (min c-full-near-cache-limit pos))) +(defun c-foreign-truncate-lit-pos-cache (beg _end) + "Truncate CC Mode's literal cache. + +This function should be added to the `before-change-functions' +hook by major modes that use CC Mode's filling functionality +without initializing CC Mode. Currently (2020-06) these are +js-mode and mhtml-mode." + (c-truncate-lit-pos-cache beg)) + +(defun c-foreign-init-lit-pos-cache () + "Initialize CC Mode's literal cache. + +This function should be called from the mode functions of major +modes which use CC Mode's filling functionality without +initializing CC Mode. Currently (2020-06) these are js-mode and +mhtml-mode." + (c-truncate-lit-pos-cache 1)) + ;; A system for finding noteworthy parens before the point. @@ -11685,7 +11696,16 @@ comment at the start of cc-engine.el for more info." (not (c-in-literal)) )))) nil) - (t t)))))) + (t t))))) + ((and + (c-major-mode-is 'c++-mode) + (eq (char-after) ?\[) + ;; Be careful of "operator []" + (not (save-excursion + (c-backward-token-2 1 nil lim) + (looking-at c-opt-op-identifier-prefix)))) + (setq braceassignp t) + nil)) (when (eq braceassignp 'dontknow) (cond ((and (not (eq (char-after) ?,)) @@ -11876,17 +11896,6 @@ comment at the start of cc-engine.el for more info." (cons (list beg) type))))) (error nil)))) -(defun c-looking-at-bos (&optional _lim) - ;; Return non-nil if between two statements or declarations, assuming - ;; point is not inside a literal or comment. - ;; - ;; Obsolete - `c-at-statement-start-p' or `c-at-expression-start-p' - ;; are recommended instead. - ;; - ;; This function might do hidden buffer changes. - (c-at-statement-start-p)) -(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") - (defun c-looking-at-statement-block () ;; Point is at an opening brace. If this is a statement block (i.e. the ;; elements in the block are terminated by semicolons, or the block is @@ -12057,7 +12066,7 @@ comment at the start of cc-engine.el for more info." (c-backward-token-2 1 nil lim) (and (not (and (c-on-identifier) - (looking-at c-symbol-chars))) + (looking-at c-symbol-char-key))) (not (looking-at c-opt-op-identifier-prefix))))))) (cons 'inlambda bracket-pos)) ((and c-recognize-paren-inexpr-blocks diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 2cbbc66c14f..386cc2f16fe 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -3016,6 +3016,84 @@ need for `pike-font-lock-extra-types'.") (c-font-lock-doc-comments "/[*/]!" limit autodoc-font-lock-doc-comments))))) +;; Doxygen + +(defconst doxygen-font-lock-doc-comments + ;; TODO: Handle @code, @verbatim, @dot, @f etc. better by not highlighting + ;; text inside of those commands. Something smarter than just regexes may be + ;; needed to do that efficiently. + `((,(concat + ;; Make sure that the special character has not been escaped. E.g. in + ;; `\@foo' only `\@' is a command (similarly for other characters like + ;; `\\foo', `\<foo' and `\&foo'). The downside now is that we don't + ;; match command started just after an escaped character, e.g. in + ;; `\@\foo' we should match `\@' as well as `\foo' but only the former + ;; is matched. + "\\(?:^\\|[^\\@]\\)\\(" + ;; Doxygen commands start with backslash or an at sign. Note that for + ;; brevity in the comments only `\' will be mentioned. + "[\\@]\\(?:" + ;; Doxygen commands except those starting with `f' + "[a-eg-z][a-z]*" + ;; Doxygen command starting with `f': + "\\|f\\(?:" + "[][$}]" ; \f$ \f} \f[ \f] + "\\|{\\(?:[a-zA-Z]+\\*?}{?\\)?" ; \f{ \f{env} \f{env}{ + "\\|[a-z]+" ; \foo + "\\)" + "\\|~[a-zA-Z]*" ; \~ \~language + "\\|[$@&~<=>#%\".|\\\\]" ; single-character escapes + "\\|::\\|---?" ; \:: \-- \--- + "\\)" + ;; HTML tags and entities: + "\\|</?\\sw\\(?:\\sw\\|\\s \\|[=\n\r*.:]\\|\"[^\"]*\"\\|'[^']*'\\)*>" + "\\|&\\(?:\\sw+\\|#[0-9]+\\|#x[0-9a-fA-F]+\\);" + "\\)") + 1 ,c-doc-markup-face-name prepend nil) + ;; Commands inside of strings are not commands so override highlighting with + ;; string face. This also affects HTML attribute values if they are + ;; surrounded with double quotes which may or may not be considered a good + ;; thing. + ("\\(?:^\\|[^\\@]\\)\\(\"[^\"[:cntrl:]]+\"\\)" + 1 font-lock-string-face prepend nil) + ;; HTML comments inside of the Doxygen comments. + ("\\(?:^\\|[^\\@]\\)\\(<!--.*?-->\\)" + 1 font-lock-comment-face prepend nil) + ;; Autolinking. Doxygen auto-links anything that is a class name but we have + ;; no hope of matching those. We are, however, able to match functions and + ;; members using explicit scoped syntax. For functions, we can also find + ;; them by noticing argument-list. Note that Doxygen accepts `::' as well + ;; as `#' as scope operators. + (,(let* ((ref "[\\@]ref\\s-+") + (ref-opt (concat "\\(?:" ref "\\)?")) + (id "[a-zA-Z_][a-zA-Z_0-9]*") + (args "\\(?:()\\|([^()]*)\\)") + (scope "\\(?:#\\|::\\)")) + (concat + "\\(?:^\\|[^\\@/%:]\\)\\(?:" + ref-opt "\\(?1:" scope "?" "\\(?:" id scope "\\)+" "~?" id "\\)" + "\\|" ref-opt "\\(?1:" scope "~?" id "\\)" + "\\|" ref-opt "\\(?1:" scope "?" "~?" id "\\)" args + "\\|" ref "\\(?1:" "~?" id "\\)" + "\\|" ref-opt "\\(?1:~[A-Z][a-zA-Z0-9_]+\\)" + "\\)")) + 1 font-lock-function-name-face prepend nil) + ;; Match URLs and emails. This has two purposes. First of all, Doxygen + ;; autolinks URLs. Second of all, `@bar' in `foo@bar.baz' has been matched + ;; above as a command; try and overwrite it. + (,(let* ((host "[A-Za-z0-9]\\(?:[A-Za-z0-9-]\\{0,61\\}[A-Za-z0-9]\\)") + (fqdn (concat "\\(?:" host "\\.\\)+" host)) + (comp "[!-(*--/-=?-~]+") + (path (concat "/\\(?:" comp "[.]+" "\\)*" comp))) + (concat "\\(?:mailto:\\)?[a-zA-0_.]+@" fqdn + "\\|https?://" fqdn "\\(?:" path "\\)?")) + 0 font-lock-keyword-face prepend nil))) + +(defconst doxygen-font-lock-keywords + `((,(lambda (limit) + (c-font-lock-doc-comments "/\\(?:/[/!]\\|\\*[\\*!]\\)" + limit doxygen-font-lock-doc-comments))))) + ;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el. (cc-provide 'cc-fonts) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index e7e7cfd4b09..b77bf3303b6 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1174,7 +1174,7 @@ since CC Mode treats every identifier as an expression." ;; Exception. ,@(when (c-major-mode-is 'c++-mode) - '((prefix "throw"))) + '((prefix "throw" "co_await" "co_yield"))) ;; Sequence. (left-assoc ",")) @@ -1769,7 +1769,7 @@ ender." `comment-start-skip' is initialized from this." ;; Default: Allow the last char of the comment starter(s) to be ;; repeated, then allow any amount of horizontal whitespace. - t (concat "\\(" + t (concat "\\(?:" (c-concat-separated (mapcar (lambda (cs) (when cs @@ -2040,6 +2040,7 @@ the appropriate place for that." (c-lang-defconst c-return-kwds "Keywords which return a value to the calling function." t '("return") + c++ '("return" "co_return") idl nil) (c-lang-defconst c-return-key @@ -2415,7 +2416,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', `c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses will be handled." t nil - objc '("@class" "@end" "@defs") + objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize" + "@compatibility_alias") java '("import" "package") pike '("import" "inherit")) @@ -2538,7 +2540,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds', "Access protection label keywords in classes." t nil c++ '("private" "protected" "public") - objc '("@private" "@protected" "@public")) + objc '("@private" "@protected" "@package" "@public" + "@required" "@optional")) (c-lang-defconst c-protection-key ;; A regexp match an element of `c-protection-kwds' cleanly. @@ -2753,7 +2756,7 @@ identifiers that follows the type in a normal declaration." "Statement keywords followed directly by a substatement." t '("do" "else") c++ '("do" "else" "try") - objc '("do" "else" "@finally" "@try") + objc '("do" "else" "@finally" "@try" "@autoreleasepool") java '("do" "else" "finally" "try") idl nil) @@ -2783,7 +2786,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'." java '("for" "if" "switch" "while" "catch" "synchronized") idl nil pike '("for" "if" "switch" "while" "foreach") - awk '("for" "if" "while")) + awk '("for" "if" "switch" "while")) (c-lang-defconst c-block-stmt-2-key ;; Regexp matching the start of any statement followed by a paren sexp @@ -2822,6 +2825,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-defconst c-simple-stmt-kwds "Statement keywords followed by an expression or nothing." t '("break" "continue" "goto" "return") + c++ '("break" "continue" "goto" "return" "co_return") objc '("break" "continue" "goto" "return" "@throw") ;; Note: `goto' is not valid in Java, but the keyword is still reserved. java '("break" "continue" "goto" "return" "throw") @@ -2862,8 +2866,7 @@ nevertheless contains a list separated with `;' and not `,'." (c-lang-defconst c-case-kwds "The keyword(s) which introduce a \"case\" like construct. This construct is \"<keyword> <expression> :\"." - t '("case") - awk nil) + t '("case")) (c-lang-defconst c-case-kwds-regexp ;; Adorned regexp matching any "case"-like keyword. @@ -2895,7 +2898,8 @@ This construct is \"<keyword> <expression> :\"." c++ (append '("nullptr") (c-lang-const c-constant-kwds c)) - objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER") + objc '("nil" "Nil" "YES" "NO" "IBAction" "IBOutlet" + "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER") idl '("TRUE" "FALSE") java '("true" "false" "null") ; technically "literals", not keywords pike '("UNDEFINED")) ;; Not a keyword, but practically works as one. @@ -3030,7 +3034,14 @@ Note that Java specific rules are currently applied to tell this from ;; can start a declaration.) "entity" "process" "service" "session" "storage")) - +(c-lang-defconst c-std-abbrev-keywords + "List of keywords which may need to cause electric indentation." + t '("else" "while") + c++ (append (c-lang-const c-std-abbrev-keywords) '("catch")) + java (append (c-lang-const c-std-abbrev-keywords) '("catch" "finally")) + idl nil) +(c-lang-defvar c-std-abbrev-keywords (c-lang-const c-std-abbrev-keywords)) + ;;; Constants built from keywords. ;; Note: No `*-kwds' language constants may be defined below this point. @@ -3405,8 +3416,14 @@ regexp should match \"(\" if parentheses are valid in declarators. The end of the first submatch is taken as the end of the operator. Identifier syntax is in effect when this is matched (see `c-identifier-syntax-table')." - t (if (c-lang-const c-type-modifier-kwds) - (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>") + t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) + (concat + (regexp-opt (c--delete-duplicates + (append (c-lang-const c-type-modifier-kwds) + (c-lang-const c-modifier-kwds)) + :test 'string-equal) + t) + "\\>") ;; Default to a regexp that never matches. regexp-unmatchable) ;; Check that there's no "=" afterwards to avoid matching tokens diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 74afeecf8f7..2ffbde99aa4 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -278,6 +278,29 @@ control). See \"cc-mode.el\" for more info." (setq defs (cdr defs))))) (put 'c-define-abbrev-table 'lisp-indent-function 1) +(defun c-populate-abbrev-table () + ;; Insert the standard keywords which may need electric indentation into the + ;; current mode's abbreviation table. + (let ((table (intern (concat (symbol-name major-mode) "-abbrev-table"))) + (defs c-std-abbrev-keywords) + ) + (unless (and (boundp table) + (abbrev-table-p (symbol-value table))) + (define-abbrev-table table nil)) + (setq local-abbrev-table (symbol-value table)) + (while defs + (unless (intern-soft (car defs) local-abbrev-table) ; Don't overwrite the + ; abbrev's use count. + (condition-case nil + (define-abbrev (symbol-value table) + (car defs) (car defs) + 'c-electric-continued-statement 0 t) + (wrong-number-of-arguments + (define-abbrev (symbol-value table) + (car defs) (car defs) + 'c-electric-continued-statement 0)))) + (setq defs (cdr defs))))) + (defun c-bind-special-erase-keys () ;; Only used in Emacs to bind C-c C-<delete> and C-c C-<backspace> ;; to the proper keys depending on `normal-erase-is-backspace'. @@ -535,6 +558,18 @@ preferably use the `c-mode-menu' language constant directly." ;; and `after-change-functions'. Note that this variable is not set when ;; `c-before-change' is invoked by a change to text properties. +(defvar c-min-syn-tab-mkr nil) +;; The minimum buffer position where there's a `c-fl-syn-tab' text property, +;; or nil if there aren't any. This is a marker, or nil if there's currently +;; no such text property. +(make-variable-buffer-local 'c-min-syn-tab-mkr) + +(defvar c-max-syn-tab-mkr nil) +;; The maximum buffer position plus 1 where there's a `c-fl-syn-tab' text +;; property, or nil if there aren't any. This is a marker, or nil if there's +;; currently no such text property. +(make-variable-buffer-local 'c-max-syn-tab-mkr) + (defun c-basic-common-init (mode default-style) "Do the necessary initialization for the syntax handling routines and the line breaking/filling code. Intended to be used by other @@ -550,6 +585,8 @@ that requires a literal mode spec at compile time." (setq c-buffer-is-cc-mode mode) + (c-populate-abbrev-table) + ;; these variables should always be buffer local; they do not affect ;; indentation style. (make-local-variable 'comment-start) @@ -606,6 +643,10 @@ that requires a literal mode spec at compile time." ;; Initialize the "brace stack" cache. (c-init-bs-cache) + ;; Keep track of where `c-fl-syn-tab' text properties are set. + (setq c-min-syn-tab-mkr nil) + (setq c-max-syn-tab-mkr nil) + (when (or c-recognize-<>-arglists (c-major-mode-is 'awk-mode) (c-major-mode-is '(java-mode c-mode c++-mode objc-mode pike-mode))) @@ -1207,52 +1248,94 @@ Note that the style variables are always made local to the buffer." (c-put-syn-tab (1- (point)) '(15))) (t nil))))) -(defvar c-fl-syn-tab-region nil) - ;; Non-nil when a `c-restore-string-fences' is "in force". It's value is a - ;; cons of the BEG and END of the region currently "mirroring" the - ;; c-fl-syn-tab properties as syntax-table properties. +(defun c-put-syn-tab (pos value) + ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to + ;; VALUE (which should not be nil). + ;; `(let ((-pos- ,pos) + ;; (-value- ,value)) + (c-put-char-property pos 'syntax-table value) + (c-put-char-property pos 'c-fl-syn-tab value) + (cond + ((null c-min-syn-tab-mkr) + (setq c-min-syn-tab-mkr (copy-marker pos t))) + ((< pos c-min-syn-tab-mkr) + (move-marker c-min-syn-tab-mkr pos))) + (cond + ((null c-max-syn-tab-mkr) + (setq c-max-syn-tab-mkr (copy-marker (1+ pos) nil))) + ((>= pos c-max-syn-tab-mkr) + (move-marker c-max-syn-tab-mkr (1+ pos)))) + (c-truncate-lit-pos-cache pos)) + +(defun c-clear-syn-tab (pos) + ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS. + (c-clear-char-property pos 'syntax-table) + (c-clear-char-property pos 'c-fl-syn-tab) + (when c-min-syn-tab-mkr + (if (and (eq pos (marker-position c-min-syn-tab-mkr)) + (eq (1+ pos) (marker-position c-max-syn-tab-mkr))) + (progn + (move-marker c-min-syn-tab-mkr nil) + (move-marker c-max-syn-tab-mkr nil) + (setq c-min-syn-tab-mkr nil c-max-syn-tab-mkr nil)) + (when (eq pos (marker-position c-min-syn-tab-mkr)) + (move-marker c-min-syn-tab-mkr + (if (c-get-char-property (1+ pos) 'c-fl-syn-tab) + (1+ pos) + (c-next-single-property-change + (1+ pos) 'c-fl-syn-tab nil c-max-syn-tab-mkr)))) + (when (eq (1+ pos) (marker-position c-max-syn-tab-mkr)) + (move-marker c-max-syn-tab-mkr + (if (c-get-char-property (1- pos) 'c-fl-syn-tab) + pos + (c-previous-single-property-change + pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr))))))) + (c-truncate-lit-pos-cache pos)) (defun c-clear-string-fences () - ;; Clear syntax-table text properties in the region defined by - ;; `c-cl-syn-tab-region' which are "mirrored" by c-fl-syn-tab text - ;; properties. However, any such " character which ends up not being + ;; Clear syntax-table text properties which are "mirrored" by c-fl-syn-tab + ;; text properties. However, any such " character which ends up not being ;; balanced by another " is left with a '(1) syntax-table property. - (when c-fl-syn-tab-region - (let ((beg (car c-fl-syn-tab-region)) - (end (cdr c-fl-syn-tab-region)) - s pos) - (setq pos beg) + (when + (and c-min-syn-tab-mkr c-max-syn-tab-mkr) + (let (s pos) + (setq pos c-min-syn-tab-mkr) (while (and - (< pos end) - (setq pos - (c-min-property-position pos end 'c-fl-syn-tab)) - (< pos end)) + (< pos c-max-syn-tab-mkr) + (setq pos (c-min-property-position pos + c-max-syn-tab-mkr + 'c-fl-syn-tab)) + (< pos c-max-syn-tab-mkr)) (c-clear-char-property pos 'syntax-table) (setq pos (1+ pos))) ;; Check we haven't left any unbalanced "s. (save-excursion - (setq pos beg) + (setq pos c-min-syn-tab-mkr) ;; Is there already an unbalanced " before BEG? - (setq pos (c-min-property-position pos end 'c-fl-syn-tab)) - (when (< pos end) (goto-char pos)) + (setq pos (c-min-property-position pos c-max-syn-tab-mkr + 'c-fl-syn-tab)) + (when (< pos c-max-syn-tab-mkr) + (goto-char pos)) (when (and (save-match-data (c-search-backward-char-property-with-value-on-char 'c-fl-syn-tab '(15) ?\" (max (- (point) 500) (point-min)))) (not (equal (c-get-char-property (point) 'syntax-table) '(1)))) (setq pos (1+ pos))) - (while (< pos end) + (while (< pos c-max-syn-tab-mkr) (setq pos - (c-min-property-position pos end 'c-fl-syn-tab)) - (when (< pos end) + (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab)) + (when (< pos c-max-syn-tab-mkr) (if (memq (char-after pos) c-string-delims) (progn ;; Step over the ". - (setq s (parse-partial-sexp pos end nil nil nil + (setq s (parse-partial-sexp pos c-max-syn-tab-mkr + nil nil nil 'syntax-table)) ;; Seek a (bogus) matching ". - (setq s (parse-partial-sexp (point) end nil nil s + (setq s (parse-partial-sexp (point) c-max-syn-tab-mkr + nil nil s 'syntax-table)) ;; When a bogus matching " is found, do nothing. ;; Otherwise mark the " with 'syntax-table '(1). @@ -1262,23 +1345,22 @@ Note that the style variables are always made local to the buffer." (c-get-char-property (1- (point)) 'c-fl-syn-tab)) (c-put-char-property pos 'syntax-table '(1))) (setq pos (point))) - (setq pos (1+ pos)))))) - (setq c-fl-syn-tab-region nil)))) - -(defun c-restore-string-fences (beg end) - ;; Restore any syntax-table text properties in the region (BEG END) which - ;; are "mirrored" by c-fl-syn-tab text properties. - (let ((pos beg)) - (while - (and - (< pos end) - (setq pos - (c-min-property-position pos end 'c-fl-syn-tab)) - (< pos end)) - (c-put-char-property pos 'syntax-table - (c-get-char-property pos 'c-fl-syn-tab)) - (setq pos (1+ pos))) - (setq c-fl-syn-tab-region (cons beg end)))) + (setq pos (1+ pos))))))))) + +(defun c-restore-string-fences () + ;; Restore any syntax-table text properties which are "mirrored" by + ;; c-fl-syn-tab text properties. + (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr) + (let ((pos c-min-syn-tab-mkr)) + (while + (and + (< pos c-max-syn-tab-mkr) + (setq pos + (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab)) + (< pos c-max-syn-tab-mkr)) + (c-put-char-property pos 'syntax-table + (c-get-char-property pos 'c-fl-syn-tab)) + (setq pos (1+ pos)))))) (defvar c-bc-changed-stringiness nil) ;; Non-nil when, in a before-change function, the deletion of a range of text @@ -1406,7 +1488,7 @@ Note that the style variables are always made local to the buffer." ;; Move to end of logical line (as it will be after the change, or as it ;; was before unescaping a NL.) - (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) + (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) ;; We're at an EOLL or point-max. (if (equal (c-get-char-property (point) 'syntax-table) '(15)) (if (memq (char-after) '(?\n ?\r)) @@ -1514,7 +1596,7 @@ Note that the style variables are always made local to the buffer." (progn (goto-char (min (1+ end) ; 1+, in case a NL has become escaped. (point-max))) - (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" + (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) (point)) c-new-END)) @@ -1595,7 +1677,7 @@ Note that the style variables are always made local to the buffer." (c-beginning-of-macro)))) (goto-char (1+ end)) ; After the \ ;; Search forward for EOLL - (setq lim (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" + (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)) (goto-char (1+ end)) (when (c-search-forward-char-property-with-value-on-char @@ -1888,7 +1970,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (widen) (unwind-protect (progn - (c-restore-string-fences (point-min) (point-max)) + (c-restore-string-fences) (save-excursion ;; Are we inserting/deleting stuff in the middle of an ;; identifier? @@ -2018,7 +2100,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (widen) (unwind-protect (progn - (c-restore-string-fences (point-min) (point-max)) + (c-restore-string-fences) (when (> end (point-max)) ;; Some emacsen might return positions past the end. This ;; has been observed in Emacs 20.7 when rereading a buffer @@ -2183,7 +2265,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") enclosing-attribute pos1) (unless lit-start (c-backward-syntactic-ws) - (when (setq enclosing-attribute (c-slow-enclosing-c++-attribute)) + (when (setq enclosing-attribute (c-enclosing-c++-attribute)) (goto-char (car enclosing-attribute))) ; Only happens in C++ Mode. (when (setq pos1 (c-on-identifier)) (goto-char pos1) @@ -2255,69 +2337,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; line was fouled up by context fontification. (save-restriction (widen) - (let (new-beg new-end new-region case-fold-search string-fence-beg lim) - ;; Check how far back we need to extend the region where we reapply the - ;; string fence syntax-table properties. These must be in place for the - ;; coming fontification operations. - (save-excursion - (goto-char (if c-in-after-change-fontification - (min beg c-new-BEG) - beg)) - (setq lim (max (- (point) 500) (point-min))) - (while + (let (new-beg new-end new-region case-fold-search) + (c-save-buffer-state nil + ;; Temporarily reapply the string fence syntax-table properties. + (unwind-protect (progn - (skip-chars-backward "^\"" lim) - (or (bobp) (backward-char)) - (save-excursion - (eq (logand (skip-chars-backward "\\\\") 1) 1)))) - (setq string-fence-beg - (cond ((c-get-char-property (point) 'c-fl-syn-tab) - (point)) - (c-in-after-change-fontification - c-new-BEG) - (t beg))) - (c-save-buffer-state nil - ;; Temporarily reapply the string fence syntax-table properties. - (c-with-extended-string-fences - string-fence-beg (if c-in-after-change-fontification - (max end c-new-END) - end) - - (if (and c-in-after-change-fontification - (< beg c-new-END) (> end c-new-BEG)) - ;; Region and the latest after-change fontification region overlap. - ;; Determine the upper and lower bounds of our adjusted region - ;; separately. - (progn - (if (<= beg c-new-BEG) - (setq c-in-after-change-fontification nil)) - (setq new-beg - (if (and (>= beg (c-point 'bol c-new-BEG)) - (<= beg c-new-BEG)) - ;; Either jit-lock has accepted `c-new-BEG', or has - ;; (probably) extended the change region spuriously - ;; to BOL, which position likely has a - ;; syntactically different position. To ensure - ;; correct fontification, we start at `c-new-BEG', - ;; assuming any characters to the left of - ;; `c-new-BEG' on the line do not require - ;; fontification. - c-new-BEG - (setq new-region (c-before-context-fl-expand-region beg end) - new-end (cdr new-region)) - (car new-region))) - (setq new-end - (if (and (>= end (c-point 'bol c-new-END)) - (<= end c-new-END)) - c-new-END - (or new-end - (cdr (c-before-context-fl-expand-region beg end)))))) - ;; Context (etc.) fontification. - (setq new-region (c-before-context-fl-expand-region beg end) - new-beg (car new-region) new-end (cdr new-region))) - ;; Finally invoke font lock's functionality. - (funcall (default-value 'font-lock-fontify-region-function) - new-beg new-end verbose))))))) + (c-restore-string-fences) + (if (and c-in-after-change-fontification + (< beg c-new-END) (> end c-new-BEG)) + ;; Region and the latest after-change fontification region overlap. + ;; Determine the upper and lower bounds of our adjusted region + ;; separately. + (progn + (if (<= beg c-new-BEG) + (setq c-in-after-change-fontification nil)) + (setq new-beg + (if (and (>= beg (c-point 'bol c-new-BEG)) + (<= beg c-new-BEG)) + ;; Either jit-lock has accepted `c-new-BEG', or has + ;; (probably) extended the change region spuriously + ;; to BOL, which position likely has a + ;; syntactically different position. To ensure + ;; correct fontification, we start at `c-new-BEG', + ;; assuming any characters to the left of + ;; `c-new-BEG' on the line do not require + ;; fontification. + c-new-BEG + (setq new-region (c-before-context-fl-expand-region beg end) + new-end (cdr new-region)) + (car new-region))) + (setq new-end + (if (and (>= end (c-point 'bol c-new-END)) + (<= end c-new-END)) + c-new-END + (or new-end + (cdr (c-before-context-fl-expand-region beg end)))))) + ;; Context (etc.) fontification. + (setq new-region (c-before-context-fl-expand-region beg end) + new-beg (car new-region) new-end (cdr new-region))) + ;; Finally invoke font lock's functionality. + (funcall (default-value 'font-lock-fontify-region-function) + new-beg new-end verbose)) + (c-clear-string-fences)))))) (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change @@ -2444,11 +2505,6 @@ opening \" and the next unescaped end of line." (funcall (c-lang-const c-make-mode-syntax-table c)) "Syntax table used in c-mode buffers.") -(c-define-abbrev-table 'c-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0)) - "Abbreviation table used in c-mode buffers.") - (defvar c-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2521,13 +2577,21 @@ Key bindings: (defconst c-or-c++-mode--regexp (eval-when-compile - (let ((id "[a-zA-Z0-9_]+") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*")) + (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*") + (headers '("string" "string_view" "iostream" "map" "unordered_map" + "set" "unordered_set" "vector" "tuple"))) (concat "^" ws-maybe "\\(?:" - "using" ws "\\(?:namespace" ws "std;\\|std::\\)" - "\\|" "namespace" "\\(:?" ws id "\\)?" ws-maybe "{" - "\\|" "class" ws id ws-maybe "[:{\n]" - "\\|" "template" ws-maybe "<.*>" - "\\|" "#include" ws-maybe "<\\(?:string\\|iostream\\|map\\)>" + "using" ws "\\(?:namespace" ws + "\\|" id "::" + "\\|" id ws-maybe "=\\)" + "\\|" "\\(?:inline" ws "\\)?namespace" + "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{" + "\\|" "class" ws id + "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]" + "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]" + "\\|" ws-maybe ":\\)" + "\\|" "template" ws-maybe "<.*?>" + "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">" "\\)"))) "A regexp applied to C header files to check if they are really C++.") @@ -2543,6 +2607,7 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-mode' or `c++-mode'." + (interactive) (if (save-excursion (save-restriction (save-match-data @@ -2560,12 +2625,6 @@ the code is C or C++ and based on that chooses whether to enable (funcall (c-lang-const c-make-mode-syntax-table c++)) "Syntax table used in c++-mode buffers.") -(c-define-abbrev-table 'c++-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0) - ("catch" "catch" c-electric-continued-statement 0)) - "Abbreviation table used in c++-mode buffers.") - (defvar c++-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2614,11 +2673,6 @@ Key bindings: (funcall (c-lang-const c-make-mode-syntax-table objc)) "Syntax table used in objc-mode buffers.") -(c-define-abbrev-table 'objc-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0)) - "Abbreviation table used in objc-mode buffers.") - (defvar objc-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2665,13 +2719,6 @@ Key bindings: (funcall (c-lang-const c-make-mode-syntax-table java)) "Syntax table used in java-mode buffers.") -(c-define-abbrev-table 'java-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0) - ("catch" "catch" c-electric-continued-statement 0) - ("finally" "finally" c-electric-continued-statement 0)) - "Abbreviation table used in java-mode buffers.") - (defvar java-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2683,7 +2730,7 @@ Key bindings: ;; since it's practically impossible to write a regexp that reliably ;; matches such a construct. Other tools are necessary. (defconst c-Java-defun-prompt-regexp - "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") + "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") (easy-menu-define c-java-menu java-mode-map "Java Mode Commands" (cons "Java" (c-lang-const c-mode-menu java))) @@ -2722,9 +2769,6 @@ Key bindings: (funcall (c-lang-const c-make-mode-syntax-table idl)) "Syntax table used in idl-mode buffers.") -(c-define-abbrev-table 'idl-mode-abbrev-table nil - "Abbreviation table used in idl-mode buffers.") - (defvar idl-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2767,11 +2811,6 @@ Key bindings: (funcall (c-lang-const c-make-mode-syntax-table pike)) "Syntax table used in pike-mode buffers.") -(c-define-abbrev-table 'pike-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0)) - "Abbreviation table used in pike-mode buffers.") - (defvar pike-mode-map (let ((map (c-make-inherited-keymap))) map) @@ -2819,11 +2858,6 @@ Key bindings: ;;;###autoload (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode)) -(c-define-abbrev-table 'awk-mode-abbrev-table - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0)) - "Abbreviation table used in awk-mode buffers.") - (defvar awk-mode-map (let ((map (c-make-inherited-keymap))) map) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 556ff6059f1..b885f6ae1d8 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -576,6 +576,7 @@ comment styles: javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode). autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode). gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++ modes). + doxygen -- Doxygen style. The value may also be a list of doc comment styles, in which case all of them are recognized simultaneously (presumably with markup cues @@ -1649,6 +1650,15 @@ white space either before or after the operator, but not both." :type 'boolean :group 'c) +(defcustom c-cpp-indent-to-body-directives '("pragma") + "Preprocessor directives which will be indented as statements. + +A list of Preprocessor directives which when reindented, or newly +typed in, will cause the \"#\" introducing the directive to be +indented as a statement." + :type '(repeat string) + :group 'c) + ;; Initialize the next two to a regexp which never matches. (defvar c-noise-macro-with-parens-name-re regexp-unmatchable) (make-variable-buffer-local 'c-noise-macro-with-parens-name-re) diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 9ddb2ab2bbb..a8fe485b702 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1294,10 +1294,10 @@ Calls `cfengine-cf-promises' with \"-s json\"." 'symbols)) syntax))) -(defun cfengine3-documentation-function () +(defun cfengine3-documentation-function (&rest _ignored) "Document CFengine 3 functions around point. -Intended as the value of `eldoc-documentation-function', which see. -Use it by enabling `eldoc-mode'." +Intended as the value of `eldoc-documentation-functions', which +see. Use it by enabling `eldoc-mode'." (let ((fdef (cfengine3--current-function))) (when fdef (cfengine3-format-function-docstring fdef)))) @@ -1322,7 +1322,7 @@ Use it by enabling `eldoc-mode'." (set (make-local-variable 'parens-require-spaces) nil) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) - "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") + "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") ;; Like Lisp mode. Without this, we lose with, say, ;; `backward-up-list' when there's an unbalanced quote in a ;; preceding comment. @@ -1390,12 +1390,8 @@ to the action header." (when buffer-file-name (shell-quote-argument buffer-file-name))))) - ;; For emacs < 25.1 where `eldoc-documentation-function' defaults to - ;; nil. - (or eldoc-documentation-function - (setq-local eldoc-documentation-function #'ignore)) - (add-function :before-until (local 'eldoc-documentation-function) - #'cfengine3-documentation-function) + (add-hook 'eldoc-documentation-functions + #'cfengine3-documentation-function nil t) (add-hook 'completion-at-point-functions #'cfengine3-completion-function nil t) diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el new file mode 100644 index 00000000000..7ef43fd4490 --- /dev/null +++ b/lisp/progmodes/cl-font-lock.el @@ -0,0 +1,289 @@ +;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*- +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. + +;; Author: Yue Daian <sheepduke@gmail.com> +;; Maintainer: Spenser Truex <web@spensertruex.com> +;; Created: 2019-06-16 +;; Old-Version: 0.3.0 +;; Package-Requires: ((emacs "24.5")) +;; Keywords: lisp wp files convenience +;; URL: https://github.com/cl-font-lock/cl-font-lock +;; Homepage: https://github.com/cl-font-lock/cl-font-lock + +;; This file is part of GNU Emacs + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Highlight all the symbols in the Common Lisp ANSI Standard. +;; Adds font-lock regexes to lisp-mode. + +;;;; Todo: + +;; - Integrate better into `lisp-mode' (e.g. enable it by default). +;; - Distinguish functions from macros like `pushnew'. + +;;; Code: + +;; The list of built-in functions and variables was actually not +;; extracted from the standard, but from SBCL with the following +;; (Common Lisp) code: + +;; (defvar *functions* nil) +;; (defvar *symbols* nil) +;; (defvar *types* nil) + +;; (let ((pack (find-package :common-lisp))) +;; (do-all-symbols (sym) +;; (cond +;; ((not (eql pack (symbol-package sym))) nil) +;; ((fboundp sym) (pushnew sym *functions*)) +;; ((find-class sym nil) (pushnew sym *types*)) +;; (t (pushnew sym *symbols*))))) + + +(defvar cl-font-lock-built-in--functions + '("+" "-" "/" "/=" "<" "<=" "=" ">" ">=" "*" "1-" "1+" "abs" "acons" "acos" + "acosh" "add-method" "adjoin" "adjustable-array-p" "adjust-array" + "allocate-instance" "alpha-char-p" "alphanumericp" "and" "append" "apply" + "apropos" "apropos-list" "aref" "arithmetic-error-operands" + "arithmetic-error-operation" "array-dimension" "array-dimensions" + "array-displacement" "array-element-type" "array-has-fill-pointer-p" + "array-in-bounds-p" "arrayp" "array-rank" "array-row-major-index" + "array-total-size" "ash" "asin" "asinh" "assoc" "assoc-if" "assoc-if-not" + "atan" "atanh" "atom" "bit" "bit-and" "bit-andc1" "bit-andc2" "bit-eqv" + "bit-ior" "bit-nand" "bit-nor" "bit-not" "bit-orc1" "bit-orc2" + "bit-vector-p" "bit-xor" "boole" "both-case-p" "boundp" + "broadcast-stream-streams" "butlast" "byte" "byte-position" "byte-size" + "call-method" "call-next-method" "car" "catch" "cdr" "ceiling" + "cell-error-name" "change-class" "char" "char/=" "char<" "char<=" "char=" + "char>" "char>=" "character" "characterp" "char-code" "char-downcase" + "char-equal" "char-greaterp" "char-int" "char-lessp" "char-name" + "char-not-equal" "char-not-greaterp" "char-not-lessp" "char-upcase" "cis" + "class-name" "class-of" "clear-input" "clear-output" "close" "clrhash" + "code-char" "coerce" "compile" "compiled-function-p" "compile-file" + "compile-file-pathname" "compiler-macro-function" "complement" "complex" + "complexp" "compute-applicable-methods" "compute-restarts" "concatenate" + "concatenated-stream-streams" "conjugate" "cons" "consp" "constantly" + "constantp" "continue" "copy-alist" "copy-list" "copy-pprint-dispatch" + "copy-readtable" "copy-seq" "copy-structure" "copy-symbol" "copy-tree" + "cos" "cosh" "count" "count-if" "count-if-not" "decf" "decode-float" + "decode-universal-time" "delete" "delete-duplicates" "delete-file" + "delete-if" "delete-if-not" "delete-package" "denominator" "deposit-field" + "describe" "describe-object" "digit-char" "digit-char-p" "directory" + "directory-namestring" "disassemble" "do-all-symbols" "documentation" + "do-external-symbols" "do-symbols" "dpb" "dribble" + "echo-stream-input-stream" "echo-stream-output-stream" "ed" "eighth" "elt" + "encode-universal-time" "endp" "enough-namestring" + "ensure-directories-exist" "ensure-generic-function" "eq" "eql" "equal" + "equalp" "eval" "evenp" "every" "exp" "export" "expt" "fboundp" "fceiling" + "fdefinition" "ffloor" "fifth" "file-author" "file-error-pathname" + "file-length" "file-namestring" "file-position" "file-string-length" + "file-write-date" "fill" "fill-pointer" "find" "find-all-symbols" + "find-class" "find-if" "find-if-not" "find-method" "find-package" + "find-restart" "find-symbol" "finish-output" "first" "float" "float-digits" + "floatp" "float-precision" "float-radix" "float-sign" "floor" "fmakunbound" + "force-output" "format" "formatter" "fourth" "fresh-line" "fround" + "ftruncate" "funcall" "function" "function-keywords" + "function-lambda-expression" "functionp" "gcd" "gensym" "gentemp" "get" + "get-decoded-time" "get-dispatch-macro-character" "getf" "gethash" + "get-internal-real-time" "get-internal-run-time" "get-macro-character" + "get-output-stream-string" "get-properties" "get-setf-expansion" + "get-universal-time" "graphic-char-p" "hash-table-count" "hash-table-p" + "hash-table-rehash-size" "hash-table-rehash-threshold" "hash-table-size" + "hash-table-test" "host-namestring" "identity" "imagpart" "import" "incf" + "initialize-instance" "input-stream-p" "inspect" "integer-decode-float" + "integer-length" "integerp" "interactive-stream-p" "intern" "intersection" + "invalid-method-error" "invoke-debugger" "invoke-restart" + "invoke-restart-interactively" "isqrt" "keywordp" "last" "lcm" "ldb" + "ldb-test" "ldiff" "length" "lisp-implementation-type" + "lisp-implementation-version" "list" "list\\*" "list-all-packages" "listen" + "list-length" "listp" "load" "load-logical-pathname-translations" + "load-time-value" "log" "logand" "logandc1" "logandc2" "logbitp" "logcount" + "logeqv" "logical-pathname" "logical-pathname-translations" "logior" + "lognand" "lognor" "lognot" "logorc1" "logorc2" "logtest" "logxor" + "long-site-name" "loop-finish" "lower-case-p" "machine-instance" + "machine-type" "machine-version" "macroexpand" "macroexpand-1" + "macro-function" "make-array" "make-array" "make-broadcast-stream" + "make-concatenated-stream" "make-condition" "make-dispatch-macro-character" + "make-echo-stream" "make-hash-table" "make-instance" + "make-instances-obsolete" "make-list" "make-load-form" + "make-load-form-saving-slots" "make-method" "make-package" "make-pathname" + "make-random-state" "make-sequence" "make-string" + "make-string-input-stream" "make-string-output-stream" "make-symbol" + "make-synonym-stream" "make-two-way-stream" "makunbound" "map" "mapc" + "mapcan" "mapcar" "mapcon" "maphash" "map-into" "mapl" "maplist" + "mask-field" "max" "member" "member-if" "member-if-not" "merge" + "merge-pathnames" "method-combination-error" "method-qualifiers" "min" + "minusp" "mismatch" "mod" "muffle-warning" "multiple-value-call" + "multiple-value-list" "multiple-value-setq" "name-char" "namestring" + "nbutlast" "nconc" "next-method-p" "nintersection" "ninth" + "no-applicable-method" "no-next-method" "not" "notany" "notevery" "nreconc" + "nreverse" "nset-difference" "nset-exclusive-or" "nstring-capitalize" + "nstring-downcase" "nstring-upcase" "nsublis" "nsubst" "nsubst-if" + "nsubst-if-not" "nsubstitute" "nsubstitute-if" "nsubstitute-if-not" "nth" + "nthcdr" "nth-value" "null" "numberp" "numerator" "nunion" "oddp" "open" + "open-stream-p" "or" "output-stream-p" "package-error-package" + "package-name" "package-nicknames" "packagep" "package-shadowing-symbols" + "package-used-by-list" "package-use-list" "pairlis" "parse-integer" + "parse-namestring" "pathname" "pathname-device" "pathname-directory" + "pathname-host" "pathname-match-p" "pathname-name" "pathnamep" + "pathname-type" "pathname-version" "peek-char" "phase" "plusp" "pop" + "position" "position-if" "position-if-not" "pprint" "pprint-dispatch" + "pprint-exit-if-list-exhausted" "pprint-fill" "pprint-indent" + "pprint-linear" "pprint-logical-block" "pprint-newline" "pprint-pop" + "pprint-tab" "pprint-tabular" "prin1" "prin1-to-string" "princ" + "princ-to-string" "print" "print-not-readable-object" "print-object" + "print-unreadable-object" "probe-file" "provide" "psetf" "psetq" "push" + "pushnew" "quote" "random" "random-state-p" "rassoc" "rassoc-if" + "rassoc-if-not" "rational" "rationalize" "rationalp" "read" "read-byte" + "read-char" "read-char-no-hang" "read-delimited-list" "read-from-string" + "read-line" "read-preserving-whitespace" "read-sequence" "readtable-case" + "readtablep" "realp" "realpart" "reduce" "reinitialize-instance" "rem" + "remf" "remhash" "remove" "remove-duplicates" "remove-if" "remove-if-not" + "remove-method" "remprop" "rename-file" "rename-package" "replace" + "require" "rest" "restart-name" "revappend" "reverse" "room" "rotatef" + "round" "row-major-aref" "rplaca" "rplacd" "sbit" "scale-float" "schar" + "search" "second" "set" "set-difference" "set-dispatch-macro-character" + "set-exclusive-or" "setf" "set-macro-character" "set-pprint-dispatch" + "setq" "set-syntax-from-char" "seventh" "shadow" "shadowing-import" + "shared-initialize" "shiftf" "short-site-name" "signum" + "simple-bit-vector-p" "simple-condition-format-arguments" + "simple-condition-format-control" "simple-string-p" "simple-vector-p" "sin" + "sinh" "sixth" "sleep" "slot-boundp" "slot-exists-p" "slot-makunbound" + "slot-missing" "slot-unbound" "slot-value" "software-type" + "software-version" "some" "sort" "special-operator-p" "sqrt" "stable-sort" + "standard-char-p" "step" "store-value" "stream-element-type" + "stream-error-stream" "stream-external-format" "streamp" "string" + "string/=" "string<" "string<=" "string=" "string>" "string>=" + "string-capitalize" "string-downcase" "string-equal" "string-greaterp" + "string-left-trim" "string-lessp" "string-not-equal" "string-not-greaterp" + "string-not-lessp" "stringp" "string-right-trim" "string-trim" + "string-upcase" "sublis" "subseq" "subsetp" "subst" "subst-if" + "subst-if-not" "substitute" "substitute-if" "substitute-if-not" "subtypep" + "svref" "sxhash" "symbol-function" "symbol-name" "symbolp" "symbol-package" + "symbol-plist" "symbol-value" "synonym-stream-symbol" "tailp" "tan" "tanh" + "tenth" "terpri" "third" "throw" "time" "trace" + "translate-logical-pathname" "translate-pathname" "tree-equal" "truename" + "truncate" "two-way-stream-input-stream" "two-way-stream-output-stream" + "type-error-datum" "type-error-expected-type" "type-of" "typep" + "unbound-slot-instance" "unexport" "unintern" "union" "unread-char" + "untrace" "unuse-package" "update-instance-for-different-class" + "update-instance-for-redefined-class" "upgraded-array-element-type" + "upgraded-complex-part-type" "upper-case-p" "use-package" + "user-homedir-pathname" "use-value" "values" "values-list" "vector" + "vectorp" "vector-pop" "vector-push" "vector-push-extend" "wild-pathname-p" + "write" "write-byte" "write-char" "write-line" "write-sequence" + "write-string" "write-to-string" "yes-or-no-p" "y-or-n-p" "zerop")) + +(defvar cl-font-lock-built-in--variables + '("//" "///" "\\*load-pathname\\*" "\\*print-pprint-dispatch\\*" + "\\*break-on-signals\\*" "\\*load-print\\*" "\\*print-pprint-dispatch\\*" + "\\*break-on-signals\\*" "\\*load-truename\\*" "\\*print-pretty\\*" + "\\*load-verbose\\*" "\\*print-radix\\*" "\\*compile-file-pathname\\*" + "\\*macroexpand-hook\\*" "\\*print-readably\\*" + "\\*compile-file-pathname\\*" "\\*modules\\*" "\\*print-right-margin\\*" + "\\*compile-file-truename\\*" "\\*package\\*" "\\*print-right-margin\\*" + "\\*compile-file-truename\\*" "\\*print-array\\*" "\\*query-io\\*" + "\\*compile-print\\*" "\\*print-base\\*" "\\*random-state\\*" + "\\*compile-verbose\\*" "\\*default-pathname-defaults\\*" + "\\*print-length\\*" "\\*readtable\\*" "\\*error-output\\*" + "\\*print-level\\*" "\\*standard-input\\*" "\\*print-case\\*" + "\\*read-base\\*" "\\*compile-verbose\\*" "\\*print-circle\\*" + "\\*print-lines\\*" "\\*standard-output\\*" "\\*features\\*" + "\\*print-miser-width\\*" "\\*read-default-float-format\\*" + "\\*debug-io\\*" "\\*print-escape\\*" "\\*read-eval\\*" + "\\*debugger-hook\\*" "\\*print-gensym\\*" "\\*read-suppress\\*" + "\\*terminal-io\\*" "\\*gensym-counter\\*" "\\*print-miser-width\\*" + "\\*trace-output\\*" "array-dimension-limit" "array-rank-limit" + "array-total-size-limit" "boole-1" "boole-2" "boole-and" "boole-andc1" + "boole-andc2" "boole-c1" "boole-c2" "boole-clr" "boole-eqv" "boole-ior" + "boole-nand" "boole-nor" "boole-orc1" "boole-orc2" "boole-set" "boole-xor" + "call-arguments-limit" "char-code-limit" "double-float-epsilon" + "double-float-negative-epsilon" "internal-time-units-per-second" + "lambda-list-keywords" "lambda-parameters-limit" + "least-negative-double-float" "least-negative-long-float" + "least-negative-normalized-double-float" + "least-negative-normalized-long-float" + "least-negative-normalized-short-float" + "least-negative-normalized-single-float" "least-negative-short-float" + "least-negative-single-float" "least-positive-double-float" + "least-positive-long-float" "least-positive-normalized-double-float" + "least-positive-normalized-long-float" + "least-positive-normalized-short-float" + "least-positive-normalized-single-float" "least-positive-short-float" + "least-positive-single-float" "long-float-epsilon" + "long-float-negative-epsilon" "most-negative-double-float" + "most-negative-fixnum" "most-negative-long-float" + "most-negative-short-float" "most-negative-single-float" + "most-positive-double-float" "most-positive-fixnum" + "most-positive-long-float" "most-positive-short-float" + "most-positive-single-float" "multiple-values-limit" "short-float-epsilon" + "short-float-negative-epsilon" "single-float-epsilon" + "single-float-negative-epsilon" "pi")) + +(defvar cl-font-lock-built-in--types + '("arithmetic-error" "array" "base-char" "base-string" "bignum" "bit-vector" + "boolean" "broadcast-stream" "built-in-class" "cell-error" "class" + "compiled-function" "concatenated-stream" "condition" "control-error" + "division-by-zero" "double-float" "echo-stream" "end-of-file" + "extended-char" "file-error" "file-stream" "fixnum" + "floating-point-inexact" "floating-point-invalid-operation" + "floating-point-overflow" "floating-point-underflow" "generic-function" + "hash-table" "integer" "keyword" "long-float" "method" "method-combination" + "number" "package" "package-error" "parse-error" "print-not-readable" + "program-error" "random-state" "ratio" "reader-error" "readtable" "real" + "restart" "sequence" "serious-condition" "short-float" "signed-byte" + "simple-array" "simple-base-string" "simple-bit-vector" "simple-condition" + "simple-error" "simple-string" "simple-type-error" "simple-vector" + "simple-warning" "single-float" "standard-char" "standard-class" + "standard-generic-function" "standard-method" "standard-object" + "storage-condition" "stream" "stream-error" "string-stream" + "structure-class" "structure-object" "style-warning" "symbol" + "synonym-stream" "two-way-stream" "type-error" "unbound-slot" + "unbound-variable" "undefined-function" "unsigned-byte" "warning")) + +(defvar cl-font-lock-built-in--symbols + '("compilation-speed" "compiler-macro" "debug" "declaration" "dynamic-extent" + "ftype" "ignorable" "ignore" "inline" "notinline" "optimize" "otherwise" + "safety" "satisfies" "space" "special" "speed" "structure" "type")) + +(defvar cl-font-lock--character-names + '("newline" "space" "rubout" "page" "tab" "backspace" "return" "linefeed")) + +(defvar cl-font-lock-built-in-keywords + (mapcar (lambda (s) + `(,(regexp-opt (symbol-value (car s)) 'symbols) + . ,(cdr s))) + '((cl-font-lock-built-in--functions . font-lock-function-name-face) + (cl-font-lock-built-in--variables . font-lock-variable-name-face) + (cl-font-lock-built-in--types . font-lock-type-face) + (cl-font-lock-built-in--symbols . font-lock-builtin-face) + (cl-font-lock--character-names . font-lock-variable-name-face)))) + +;;;###autoload +(define-minor-mode cl-font-lock-built-in-mode + "Highlight built-in functions, variables, and types in `lisp-mode'." + :global t + (funcall + (if cl-font-lock-built-in-mode + #'font-lock-add-keywords + #'font-lock-remove-keywords) + 'lisp-mode + cl-font-lock-built-in-keywords)) + +(provide 'cl-font-lock) + +;;; cl-font-lock.el ends here diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 455f181f501..13b672bd53b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -221,9 +221,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; considered before EDG. ;; The message may be a "warning", "error", or "fatal error" with ;; an error code, or "see declaration of" without an error code. - "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)) ?\ + "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?) ?\ : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)" - 2 3 nil (4)) + 2 3 4 (5)) (edg-1 "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" @@ -265,6 +265,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (java "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) + (javac + ,(concat + ;; line1 + "^\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\):" ;file + "\\([0-9]+\\): " ;line + "\\(warning: \\)?.*\n" ;type (optional) and message + ;; line2: source line containing error + ".*\n" + ;; line3: single "^" under error position in line2 + " *\\^$") + 1 2 + ,(lambda () (1- (current-column))) + (3)) + (jikes-file "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0) @@ -302,8 +316,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (gcc-include "^\\(?:In file included \\| \\|\t\\)from \ \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\ -\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" - 1 2 3 (4 . 5)) +\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\([:,]\\|$\\)\\)?" + 1 2 3 (nil . 4)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) @@ -646,6 +660,16 @@ matched file names, and weeding out false positives." :link `(file-link :tag "example file" ,(expand-file-name "compilation.txt" data-directory))) +(defvar compilation-error-case-fold-search nil + "If non-nil, use case-insensitive matching of compilation errors +by the regexps of `compilation-error-regexp-alist' and +`compilation-error-regexp-alist-alist'. +If nil, matching is case-sensitive. + +This variable should only be set for backward compatibility as a temporary +measure. The proper solution is to use a regexp that matches the +messages without case-folding.") + ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp) (defvar compilation-directory nil "Directory to restore to when doing `recompile'.") @@ -1124,12 +1148,13 @@ POS and RES.") (setcdr l1 (cons (list ,key) l2))))))) (defun compilation-auto-jump (buffer pos) - (with-current-buffer buffer - (goto-char pos) - (let ((win (get-buffer-window buffer 0))) - (if win (set-window-point win pos))) - (if compilation-auto-jump-to-first-error - (compile-goto-error)))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char pos) + (let ((win (get-buffer-window buffer 0))) + (if win (set-window-point win pos))) + (if compilation-auto-jump-to-first-error + (compile-goto-error))))) ;; This function is the central driver, called when font-locking to gather ;; all information needed to later jump to corresponding source code. @@ -1435,7 +1460,8 @@ to `compilation-error-regexp-alist' if RULES is nil." (if (symbolp item) (setq item (cdr (assq item compilation-error-regexp-alist-alist)))) - (let ((file (nth 1 item)) + (let ((case-fold-search compilation-error-case-fold-search) + (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) @@ -1455,9 +1481,15 @@ to `compilation-error-regexp-alist' if RULES is nil." nil) ;; Not anchored or anchored but already allows empty spaces. (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) - (if (consp file) (setq fmt (cdr file) file (car file))) - (if (consp line) (setq end-line (cdr line) line (car line))) - (if (consp col) (setq end-col (cdr col) col (car col))) + (if (and (consp file) (not (functionp file))) + (setq fmt (cdr file) + file (car file))) + (if (and (consp line) (not (functionp line))) + (setq end-line (cdr line) + line (car line))) + (if (and (consp col) (not (functionp col))) + (setq end-col (cdr col) + col (car col))) (unless (or (null (nth 5 item)) (integerp (nth 5 item))) (error "HYPERLINK should be an integer: %s" (nth 5 item))) @@ -2033,6 +2065,8 @@ Returns the compilation buffer created." (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) (define-key map "\t" 'compilation-next-error) (define-key map [backtab] 'compilation-previous-error) (define-key map "g" 'recompile) ; revert @@ -2342,12 +2376,10 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) -;;; test if a buffer is a compilation buffer, assuming we're in the buffer (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) -;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p (defsubst compilation-buffer-p (buffer) "Test if BUFFER is a compilation buffer." (with-current-buffer buffer @@ -2388,12 +2420,9 @@ and runs `compilation-filter-hook'." &optional object limit) (let (parsed res) (while (progn - ;; We parse the buffer here "on-demand" by chunks of 500 chars. - ;; But we could also just parse the whole buffer. (compilation--ensure-parse (setq parsed (max compilation--parsed - (min (+ position 500) - (or limit (point-max)))))) + (or limit (point-max))))) (and (or (not (setq res (next-single-property-change position prop object limit))) (eq res limit)) @@ -2884,11 +2913,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (and w (progn (compilation-set-window w marker) (compilation-set-overlay-arrow w)))) (let* ((name (read-file-name - (format "Find this %s in%s: " - compilation-error - (if filename - (format " (default %s)" filename) - "")) + (format-prompt "Find this %s in" + filename compilation-error) spec-dir filename t nil ;; The predicate below is fine when called from ;; minibuffer-complete-and-exit, but it's too diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5fee2df5863..af179e2797e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -451,8 +451,7 @@ Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) -(defcustom cperl-use-syntax-table-text-property - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-use-syntax-table-text-property t "Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean :group 'cperl-speed) @@ -535,8 +534,7 @@ One should tune up `cperl-close-paren-offset' as well." :type 'boolean :group 'cperl-indentation-details) -(defcustom cperl-syntaxify-by-font-lock - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-syntaxify-by-font-lock t "Non-nil means that CPerl uses the `font-lock' routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) @@ -1081,10 +1079,6 @@ versions of Emacs." (define-key map [(control ?c) (control ?h) ?v] ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help)) - (or (boundp 'fill-paragraph-function) - (substitute-key-definition - 'fill-paragraph 'cperl-fill-paragraph - map global-map)) (substitute-key-definition 'indent-sexp 'cperl-indent-exp map global-map) @@ -1306,7 +1300,7 @@ the last)." cperl-maybe-white-and-comment-rex ; whitespace-comments "\\(\\sw\\|_\\)+" ; attr-name ;; attr-arg (1 level of internal parens allowed!) - "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?" + "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?" "\\(" ; optional : (XXX allows trailing???) cperl-maybe-white-and-comment-rex ; whitespace-comments ":\\)?" @@ -1406,7 +1400,7 @@ the last)." (defvar cperl-font-locking nil) ;; NB as it stands the code in cperl-mode assumes this only has one -;; element. If XEmacs 19 support were dropped, this could all be simplified. +;; element. Since XEmacs 19 support has been dropped, this could all be simplified. (defvar cperl-compilation-error-regexp-alist ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS). '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" @@ -1637,9 +1631,8 @@ or as help on variables `cperl-tips', `cperl-problems', "\\)" cperl-maybe-white-and-comment-rex)) (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent) - (and (boundp 'fill-paragraph-function) - (set (make-local-variable 'fill-paragraph-function) - #'cperl-fill-paragraph)) + (set (make-local-variable 'fill-paragraph-function) + #'cperl-fill-paragraph) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'indent-region-function) #'cperl-indent-region) ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off! @@ -1701,13 +1694,8 @@ or as help on variables `cperl-tips', `cperl-problems', ;; to make font-lock think that font-lock-syntactic-keywords ;; are defined. '(t))))) - (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities - (progn - (setq cperl-font-lock-multiline t) ; Not localized... - (set (make-local-variable 'font-lock-multiline) t)) - (set (make-local-variable 'font-lock-fontify-region-function) - ;; not present with old Emacs - #'cperl-font-lock-fontify-region-function)) + (setq cperl-font-lock-multiline t) ; Not localized... + (set (make-local-variable 'font-lock-multiline) t) (set (make-local-variable 'font-lock-fontify-region-function) #'cperl-font-lock-fontify-region-function) (make-local-variable 'cperl-old-style) @@ -3253,8 +3241,8 @@ Return the error message (if any). Does not work if delimiter is `)'. Works before syntax recognition is done." ;; Works *before* syntax recognition is done (or st-l (setq st-l (list nil))) ; Avoid overwriting '() - (let (st b reset-st) - (condition-case b + (let (st result reset-st) + (condition-case err (progn (setq st (cperl-cached-syntax-table st-l)) (modify-syntax-entry ?\( "()" st) @@ -3262,8 +3250,7 @@ Works before syntax recognition is done." (setq reset-st (syntax-table)) (set-syntax-table st) (forward-sexp 1)) - (error (message - "cperl-forward-group-in-re: error %s" b))) + (error (setq result err))) ;; now restore the initial state (if st (progn @@ -3271,7 +3258,7 @@ Works before syntax recognition is done." (modify-syntax-entry ?\) "." st))) (if reset-st (set-syntax-table reset-st)) - b)) + result)) (defvar font-lock-string-face) @@ -3560,19 +3547,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|^\n\\)=" ; POD "\\|" ;; One extra () before this: - "<<~?" ; HERE-DOC - "\\(" ; 1 + 1 + "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2 + "\\(" ; 2 + 1 ;; First variant "BLAH" or just ``. "[ \t]*" ; Yes, whitespace is allowed! - "\\([\"'`]\\)" ; 2 + 1 = 3 - "\\([^\"'`\n]*\\)" ; 3 + 1 - "\\3" + "\\([\"'`]\\)" ; 3 + 1 = 4 + "\\([^\"'`\n]*\\)" ; 4 + 1 + "\\4" "\\|" ;; Second variant: Identifier or \ID (same as 'ID') or empty - "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 + "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1 ;; Do not have <<= or << 30 or <<30 or << $blah. ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 - "\\(\\)" ; To preserve count of pars :-( 6 + 1 "\\)" "\\|" ;; 1+6 extra () before this: @@ -3762,11 +3748,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 ;; "\\)" - ((match-beginning 2) ; 1 + 1 + ((match-beginning 3) ; 2 + 1 (setq b (point) tb (match-beginning 0) c (and ; not HERE-DOC - (match-beginning 5) + (match-beginning 6) (save-match-data (or (looking-at "[ \t]*(") ; << function_call() (save-excursion ; 1 << func_name, or $foo << 10 @@ -3793,17 +3779,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>"))) (error t))))))) (error nil))) ; func(<<EOF) - (and (not (match-beginning 6)) ; Empty + (and (not (match-beginning 7)) ; Empty (looking-at "[ \t]*[=0-9$@%&(]")))))) (if c ; Not here-doc nil ; Skip it. - (setq c (match-end 2)) ; 1 + 1 - (if (match-beginning 5) ;4 + 1 - (setq b1 (match-beginning 5) ; 4 + 1 - e1 (match-end 5)) ; 4 + 1 - (setq b1 (match-beginning 4) ; 3 + 1 - e1 (match-end 4))) ; 3 + 1 + (setq c (match-end 3)) ; 2 + 1 + (if (match-beginning 6) ;6 + 1 + (setq b1 (match-beginning 6) ; 5 + 1 + e1 (match-end 6)) ; 5 + 1 + (setq b1 (match-beginning 5) ; 4 + 1 + e1 (match-end 5))) ; 4 + 1 (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify @@ -3818,8 +3804,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq b (point)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (and (re-search-forward (concat "^[ \t]*" qtag "$") - stop-point 'toend) + (or (and (re-search-forward + (concat "^" (when (equal (match-string 2) "~") "[ \t]*") + qtag "$") + stop-point 'toend) ;;;(eq (following-char) ?\n) ; XXXX WHY??? ) (progn ; Pretend we matched at the end @@ -3978,6 +3966,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) + ;; { $a++ / $b } doesn't start a regex, nor does $a-- + (not (and (memq (preceding-char) '(?+ ?-)) + (eq (preceding-char) (char-before (1- (point)))))) ;; m|blah| ? foo : bar; (not (and (eq c ?\?) @@ -4828,9 +4819,10 @@ conditional/loop constructs." (while (< (point) tmp-end) (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol (or (eolp) (forward-sexp 1))) - (if (> (point) tmp-end) ; Yes, there an unfinished block + (if (> (point) tmp-end) ; Check for an unfinished block nil (if (eq ?\) (preceding-char)) + ;; closing parens can be preceded by up to three sexps (progn ;; Plan B: find by REGEXP block followup this line (setq top (point)) (condition-case nil @@ -4851,7 +4843,9 @@ conditional/loop constructs." (progn (goto-char top) (forward-sexp 1) - (setq top (point))))) + (setq top (point))) + ;; no block to be processed: expression ends here + (setq done t))) (error (setq done t))) (goto-char top)) (if (looking-at ; Try Plan C: continuation block @@ -4884,7 +4878,7 @@ Returns some position at the last line." ;; }? continue ;; blah; } (if (not - (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") + (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|unless\\|until\\)\\_>") (setq have-brace (save-excursion (search-forward "}" ee t))))) nil ; Do not need to do anything ;; Looking at: @@ -4892,7 +4886,7 @@ Returns some position at the last line." ;; else (if cperl-merge-trailing-else (if (looking-at - "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (setq p (point)) @@ -4900,7 +4894,7 @@ Returns some position at the last line." (delete-region p (point)) (insert (make-string cperl-indent-region-fix-constructs ?\s)) (beginning-of-line))) - (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (save-excursion (search-forward "}") (delete-horizontal-space) @@ -4912,7 +4906,7 @@ Returns some position at the last line." (setq ret (point))))))) ;; Looking at: ;; } else - (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (delete-horizontal-space) @@ -5447,8 +5441,7 @@ indentation and initial hashes. Behaves usually outside of comment." (cond ((featurep 'ps-print) (or cperl-faces-init (progn - (and (boundp 'font-lock-multiline) - (setq cperl-font-lock-multiline t)) + (setq cperl-font-lock-multiline t) (cperl-init-faces)))) ((not cperl-faces-init) (add-hook 'font-lock-mode-hook @@ -5495,12 +5488,8 @@ indentation and initial hashes. Behaves usually outside of comment." (condition-case errs (progn (require 'font-lock) - (and (fboundp 'font-lock-fontify-anchored-keywords) - (featurep 'font-lock-extra) - (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - (if (fboundp 'font-lock-fontify-anchored-keywords) - (setq font-lock-anchored t)) + (setq font-lock-anchored t) (setq t-font-lock-keywords (list @@ -5659,16 +5648,16 @@ indentation and initial hashes. Behaves usually outside of comment." '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) (cond ((featurep 'font-lock-extra) - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} (font-lock-anchored - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" nil nil (1 font-lock-string-face t)))) - (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) @@ -5752,7 +5741,7 @@ indentation and initial hashes. Behaves usually outside of comment." (if (eq (char-after (match-beginning 2)) ?%) 'cperl-hash-face 'cperl-array-face) - t) ; arrays and hashes + nil) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) @@ -5787,8 +5776,8 @@ indentation and initial hashes. Behaves usually outside of comment." t-font-lock-keywords) cperl-font-lock-keywords cperl-font-lock-keywords-1 cperl-font-lock-keywords-2 (append - cperl-font-lock-keywords-1 - t-font-lock-keywords-1))) + t-font-lock-keywords-1 + cperl-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) (eval ; Avoid a warning @@ -6317,8 +6306,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (interactive (let* ((default (cperl-word-at-point)) (read (read-string - (format "Find doc for Perl function (default %s): " - default)))) + (format-prompt "Find doc for Perl function" default)))) (list (if (equal read "") default read)))) @@ -6499,9 +6487,10 @@ If optional argument ALL is `recursive', will process Perl files in subdirectories too." (interactive) (let ((cmd "etags") - (args '("-l" "none" "-r" + (args `("-l" "none" "-r" ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) - "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" + ,(concat + "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/") "-r" "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" "-r" @@ -6786,6 +6775,7 @@ Use as (or topdir (setq topdir default-directory)) (let ((tags-file-name "TAGS") + (inhibit-read-only t) (case-fold-search nil) xs rel) (save-excursion @@ -6851,7 +6841,7 @@ Use as (insert (cperl-find-tags file xs topdir)))))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup - (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? + (if (fboundp 'initialize-new-tags-table) (initialize-new-tags-table)))))) (defvar cperl-tags-hier-regexp-list @@ -8275,10 +8265,7 @@ the appropriate statement modifier." (interactive (list (let* ((default-entry (cperl-word-at-point)) (input (read-string - (format "perldoc entry%s: " - (if (string= default-entry "") - "" - (format " (default %s)" default-entry)))))) + (format-prompt "perldoc entry" default-entry)))) (if (string= input "") (if (string= default-entry "") (error "No perldoc args given") diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index dfb987bf99a..6e84f4f1bcc 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -4,7 +4,7 @@ ;; Author: Anders Lindgren ;; Keywords: c, languages, faces -;; Version: 1.3.1 +;; Old-Version: 1.3.1 ;; This file is part of GNU Emacs. @@ -168,6 +168,8 @@ deactivated." :tag "Load Hook" :group 'cwarn :type 'hook) +(make-obsolete-variable 'cwarn-load-hook + "use `with-eval-after-load' instead." "28.1") ;;}}} ;;{{{ The modes diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index dc6bd44e482..bf9b0e961ba 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -474,11 +474,10 @@ (aset ebnf-abn-token-table ?\; 'comment))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-abn-non-terminal-chars - (ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377)) + "-_0-9A-Za-z\u00a0-\u00ff") (defconst ebnf-abn-non-terminal-letter-chars - (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + "A-Za-z\u00a0-\u00ff") (defun ebnf-abn-lex () @@ -572,9 +571,8 @@ See documentation for variable `ebnf-abn-lex'." (not eor-p))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-abn-comment-chars - (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237)) + "^\n\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-abn-skip-comment () @@ -612,9 +610,8 @@ See documentation for variable `ebnf-abn-lex'." (ebnf-buffer-substring ebnf-abn-comment-chars)) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-abn-string-chars - (ebnf-range-regexp " -!#-~" ?\240 ?\377)) + " !#-~\u00a0-\u00ff") (defun ebnf-abn-string () diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 583740d3617..4e11862c1dc 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -419,9 +419,8 @@ (aset ebnf-bnf-token-table ebnf-lex-eop-char 'period))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-bnf-non-terminal-chars - (ebnf-range-regexp "!#%&'*-,0-:<>@-Z\\\\^-z~" ?\240 ?\377)) + "!#%&'*-,0-:<>@-Z\\\\^-z~\u00a0-\u00ff") (defun ebnf-bnf-lex () @@ -520,9 +519,8 @@ See documentation for variable `ebnf-bnf-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-bnf-comment-chars - (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237)) + "^\n\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-bnf-skip-comment () diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 7e824e487aa..bdebf0db2c1 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -1108,9 +1108,8 @@ (aset ebnf-dtd-token-table ?\] 'end-subset))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-dtd-name-chars - (ebnf-range-regexp "-._:0-9A-Za-z" ?\240 ?\377)) + "-._:0-9A-Za-z\u00a0-\u00ff") (defconst ebnf-dtd-decl-alist @@ -1263,11 +1262,10 @@ See documentation for variable `ebnf-dtd-lex'." (format "%s%s;" start char))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-dtd-double-string-chars - (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) + "\t -!#-~\u00a0-\u00ff") (defconst ebnf-dtd-single-string-chars - (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) + "\t -&(-~\u00a0-\u00ff") (defun ebnf-dtd-string (delim) @@ -1287,11 +1285,10 @@ See documentation for variable `ebnf-dtd-lex'." (forward-char))))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-dtd-comment-chars - (ebnf-range-regexp "^-\000-\010\013\014\016-\037" ?\177 ?\237)) + "^-\000-\010\013\014\016-\037\177\u0080-\u009f") (defconst ebnf-dtd-filename-chars - (ebnf-range-regexp "^-\000-\037" ?\177 ?\237)) + "^-\000-\037\177\u0080-\u009f") (defun ebnf-dtd-skip-comment () diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 2ae6fb67569..20e2d4ca31c 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -405,11 +405,10 @@ (aset ebnf-ebx-token-table ?/ 'comment))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-non-terminal-chars - (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377)) + "-_A-Za-z\u00a0-\u00ff") (defconst ebnf-ebx-non-terminal-letter-chars - (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + "A-Za-z\u00a0-\u00ff") (defun ebnf-ebx-lex () @@ -488,9 +487,8 @@ See documentation for variable `ebnf-ebx-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-constraint-chars - (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237)) + "^\000-\010\016-\037]\177\u0080-\u009f") (defun ebnf-ebx-skip-constraint () @@ -517,11 +515,10 @@ See documentation for variable `ebnf-ebx-lex'." (not eor-p))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-comment-chars - (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237)) + "^\000-\010\016-\037*\177\u0080-\u009f") (defconst ebnf-ebx-filename-chars - (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237)) + "^\000-\037*\177\u0080-\u009f") (defun ebnf-ebx-skip-comment () @@ -581,11 +578,10 @@ See documentation for variable `ebnf-ebx-lex'." (concat fname (make-string nchar ?*))))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-double-string-chars - (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) + "\t -!#-~\u00a0-\u00ff") (defconst ebnf-ebx-single-string-chars - (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) + "\t -&(-~\u00a0-\u00ff") (defun ebnf-ebx-string (delim) diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index b52094a5912..466e7785053 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -379,9 +379,8 @@ (aset ebnf-iso-token-table ?. 'character))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-iso-non-terminal-chars - (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377)) + " 0-9A-Za-z_\u00a0-\u00ff") (defun ebnf-iso-lex () @@ -487,9 +486,8 @@ See documentation for variable `ebnf-iso-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-iso-comment-chars - (ebnf-range-regexp "^*(\000-\010\016-\037" ?\177 ?\237)) + "^*(\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-iso-skip-comment () diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index f5d633e8460..a657c637f82 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -397,9 +397,8 @@ See documentation for variable `ebnf-yac-lex'." (< (point) ebnf-limit)) -;; replace the range "\177-\377" (see `ebnf-range-regexp'). (defconst ebnf-yac-skip-chars - (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377)) + "^{}/'\"\000-\010\013\016-\037\177\u0080-\u009f") (defun ebnf-yac-skip-code () @@ -442,9 +441,8 @@ See documentation for variable `ebnf-yac-lex'." )) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-yac-comment-chars - (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237)) + "^*\000-\010\013\016-\037\177\u0080-\u009f") (defun ebnf-yac-skip-comment () diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 640cb576ef6..22c70bf734d 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1157,21 +1157,6 @@ Please send all bug fixes and enhancements to (and (string< ps-print-version "5.2.3") (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) - -;; to avoid gripes with Emacs 20 -(or (fboundp 'assq-delete-all) - (defun assq-delete-all (key alist) - "Delete from ALIST all elements whose car is KEY. -Return the modified alist. -Elements of ALIST that are not conses are ignored." - (let ((tail alist)) - (while tail - (if (and (consp (car tail)) - (eq (car (car tail)) key)) - (setq alist (delq (car tail) alist))) - (setq tail (cdr tail))) - alist))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: @@ -2053,8 +2038,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)." ;; Printing color requires x-color-values. -(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs - (fboundp 'color-instance-rgb-components)) ; XEmacs +(defcustom ebnf-color-p t "Non-nil means use color." :type 'boolean :version "20" @@ -2738,8 +2722,7 @@ Used in functions `ebnf-reset-style', `ebnf-push-style' and (ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold)) (ebnf-eps-footer . nil) (ebnf-entry-percentage . 0.5) - (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs - (fboundp 'color-instance-rgb-components))) ; XEmacs + (ebnf-color-p . t) (ebnf-line-width . 1.0) (ebnf-line-color . "Black") (ebnf-debug-ps . nil) @@ -4544,7 +4527,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) (ebnf-total (length ebnf-tree)) (ebnf-nprod 0) @@ -4646,7 +4629,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) ps-zebra-stripes ps-line-number ps-razzle-dazzle ps-print-hook @@ -4979,18 +4962,6 @@ killed after process termination." (kill-buffer (current-buffer)))) -;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward' -;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or -;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or -;; from \177 to \237). It seems that version 20.7 has the same problem. -(defun ebnf-range-regexp (prefix from to) - (let (str) - (while (<= from to) - (setq str (concat str (char-to-string from)) - from (1+ from))) - (concat prefix str))) - - (defvar ebnf-map-name (let ((map (make-vector 256 ?\_))) (mapc #'(lambda (char) @@ -5004,8 +4975,6 @@ killed after process termination." (defun ebnf-eps-filename (str) (let* ((len (length str)) (stri 0) - ;; to keep compatibility with Emacs 20 & 21: - ;; DO NOT REPLACE `?\ ' BY `?\s' (new (make-string len ?\ ))) (while (< stri len) (aset new stri (aref ebnf-map-name (aref str stri))) @@ -5987,8 +5956,7 @@ killed after process termination." (point)))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). -(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377)) +(defconst ebnf-8-bit-chars "\u00a0-\u00ff") (defun ebnf-string (chars eos-char kind) @@ -6023,8 +5991,6 @@ killed after process termination." (defun ebnf-trim-right (str) (let* ((len (1- (length str))) (index len)) - ;; to keep compatibility with Emacs 20 & 21: - ;; DO NOT REPLACE `?\ ' BY `?\s' (while (and (> index 0) (= (aref str index) ?\ )) (setq index (1- index))) (if (= index len) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index bb780259333..1c9e805f039 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -34,6 +34,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (require 'easymenu) (require 'view) (require 'ebuff-menu) @@ -52,32 +53,27 @@ "List of directories to search for source files in a class tree. Elements should be directory names; nil as an element means to try to find source files relative to the location of the BROWSE file loaded." - :group 'ebrowse :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) (defcustom ebrowse-view/find-hook nil "Hooks run after finding or viewing a member or class." - :group 'ebrowse :type 'hook) (defcustom ebrowse-not-found-hook nil "Hooks run when finding or viewing a member or class was not successful." - :group 'ebrowse :type 'hook) (defcustom ebrowse-electric-list-mode-hook nil "Hook called by `ebrowse-electric-position-mode'." - :group 'ebrowse :type 'hook) (defcustom ebrowse-max-positions 50 "Number of markers saved on electric position stack." - :group 'ebrowse :type 'integer) @@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded." (defcustom ebrowse-tree-mode-hook nil "Hook run in each new tree buffer." - :group 'ebrowse-tree :type 'hook) (defcustom ebrowse-tree-buffer-name "*Tree*" "The default name of class tree buffers." - :group 'ebrowse-tree :type 'string) (defcustom ebrowse--indentation 4 "The amount by which subclasses are indented in the tree." - :group 'ebrowse-tree :type 'integer) (defcustom ebrowse-source-file-column 40 "The column in which source file names are displayed in the tree." - :group 'ebrowse-tree :type 'integer) (defcustom ebrowse-tree-left-margin 2 "Amount of space left at the left side of the tree display. This space is used to display markers." - :group 'ebrowse-tree :type 'integer) @@ -126,25 +117,21 @@ This space is used to display markers." (defcustom ebrowse-default-declaration-column 25 "The column in which member declarations are displayed in member buffers." - :group 'ebrowse-member :type 'integer) (defcustom ebrowse-default-column-width 25 "The width of the columns in member buffers (short display form)." - :group 'ebrowse-member :type 'integer) (defcustom ebrowse-member-buffer-name "*Members*" "The name of the buffer for member display." - :group 'ebrowse-member :type 'string) (defcustom ebrowse-member-mode-hook nil "Run in each new member buffer." - :group 'ebrowse-member :type 'hook) @@ -156,81 +143,47 @@ This space is used to display markers." (defface ebrowse-tree-mark '((((min-colors 88)) :foreground "red1") (t :foreground "red")) - "Face for the mark character in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for the mark character in the Ebrowse tree.") (defface ebrowse-root-class '((((min-colors 88)) :weight bold :foreground "blue1") (t :weight bold :foreground "blue")) - "Face for root classes in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for root classes in the Ebrowse tree.") (defface ebrowse-file-name '((t :slant italic)) - "Face for filenames in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for filenames in the Ebrowse tree.") (defface ebrowse-default '((t)) - "Face for items in the Ebrowse tree which do not have other faces." - :group 'ebrowse-faces) + "Face for items in the Ebrowse tree which do not have other faces.") (defface ebrowse-member-attribute '((((min-colors 88)) :foreground "red1") (t :foreground "red")) - "Face for member attributes." - :group 'ebrowse-faces) + "Face for member attributes.") (defface ebrowse-member-class '((t :foreground "purple")) - "Face used to display the class title in member buffers." - :group 'ebrowse-faces) + "Face used to display the class title in member buffers.") (defface ebrowse-progress '((((min-colors 88)) :background "blue1") (t :background "blue")) - "Face for progress indicator." - :group 'ebrowse-faces) + "Face for progress indicator.") ;;; Utilities. -(defun ebrowse-some (predicate vector) - "Return true if PREDICATE is true of some element of VECTOR. -If so, return the value returned by PREDICATE." - (let ((length (length vector)) - (i 0) - result) - (while (and (< i length) (not result)) - (setq result (funcall predicate (aref vector i)) - i (1+ i))) - result)) +(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1") -(defun ebrowse-every (predicate vector) - "Return true if PREDICATE is true of every element of VECTOR." - (let ((length (length vector)) - (i 0) - (result t)) - (while (and (< i length) result) - (setq result (funcall predicate (aref vector i)) - i (1+ i))) - result)) +(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1") (defun ebrowse-position (item list &optional test) "Return the position of ITEM in LIST or nil if not found. Compare items with `eq' or TEST if specified." - (let ((i 0) found) - (cond (test - (while list - (when (funcall test item (car list)) - (setq found i list nil)) - (setq list (cdr list) i (1+ i)))) - (t - (while list - (when (eq item (car list)) - (setq found i list nil)) - (setq list (cdr list) i (1+ i))))) - found)) + (declare (obsolete seq-position "28.1")) + (seq-position list item (or test #'eql))) (defmacro ebrowse-ignoring-completion-case (&rest body) @@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified." (defmacro ebrowse-for-all-trees (spec &rest body) "For all trees in SPEC, eval BODY." (declare (indent 1) (debug ((sexp form) body))) - (let ((var (make-symbol "var")) - (spec-var (car spec)) + (let ((spec-var (car spec)) (array (cadr spec))) - `(cl-loop for ,var being the symbols of ,array - as ,spec-var = (get ,var 'ebrowse-root) do - (when (vectorp ,spec-var) - ,@body)))) - -;;; Set indentation for macros above. - - + `(maphash (lambda (_k ,spec-var) + (when ,spec-var + (cl-assert (cl-typep ,spec-var 'ebrowse-ts)) + ,@body)) + ,array))) (defsubst ebrowse-set-face (start end face) "Set face of a region START END to FACE." @@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified." Case is ignored in completions. PROMPT is a string to prompt with; normally it ends in a colon and a space. -TABLE is an alist whose elements' cars are strings, or an obarray. -TABLE can also be a function to do the completion itself. +TABLE is a completion table. If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string." @@ -304,6 +252,9 @@ otherwise use the current frame's width." ;;; Structure definitions +;; Note: These use `(:type vector) :named' in order to match the +;; format used in src/BROWSE. + (cl-defstruct (ebrowse-hs (:type vector) :named) "Header structure found at the head of BROWSE files." ;; A version string that is compared against the version number of @@ -457,19 +408,17 @@ members." This must be the same that `ebrowse' uses.") -(defvar ebrowse--last-regexp nil +(defvar-local ebrowse--last-regexp nil "Last regular expression searched for in tree and member buffers. Each tree and member buffer maintains its own search history.") -(make-variable-buffer-local 'ebrowse--last-regexp) - (defconst ebrowse-member-list-accessors - '(ebrowse-ts-member-variables - ebrowse-ts-member-functions - ebrowse-ts-static-variables - ebrowse-ts-static-functions - ebrowse-ts-friends - ebrowse-ts-types) + (list #'ebrowse-ts-member-variables + #'ebrowse-ts-member-functions + #'ebrowse-ts-static-variables + #'ebrowse-ts-static-functions + #'ebrowse-ts-friends + #'ebrowse-ts-types) "List of accessors for member lists. Each element is the symbol of an accessor function. The nth element must be the accessor for the nth member list @@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.") ;;; FIXME: Add more doc strings for the buffer-local variables below. -(defvar ebrowse--tree-obarray nil - "Obarray holding all `ebrowse-ts' structures of a class tree. +(defvar ebrowse--tree-table nil + "Hash-table holding all `ebrowse-ts' structures of a class tree. Buffer-local in Ebrowse buffers.") @@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.") ;;; Operations on `ebrowse-ts' structures (defun ebrowse-files-table (&optional marked-only) - "Return an obarray containing all files mentioned in the current tree. -The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. + "Return a hash table containing all files mentioned in the current tree. +The tree is expected in the buffer-local variable `ebrowse--tree-table'. MARKED-ONLY non-nil means include marked classes only." (let ((files (make-hash-table :test 'equal)) (i -1)) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (when (or (not marked-only) (ebrowse-ts-mark tree)) (let ((class (ebrowse-ts-class tree))) (when (zerop (% (cl-incf i) 20)) @@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only." (cl-defun ebrowse-marked-classes-p () "Value is non-nil if any class in the current class tree is marked." - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (when (ebrowse-ts-mark tree) (cl-return-from ebrowse-marked-classes-p tree)))) @@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only." (ebrowse-cs-name class))) -(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) +(defun ebrowse-tree-table-as-alist (&optional qualified-names-p) "Return an alist describing all classes in a tree. Each elements in the list has the form (CLASS-NAME . TREE). CLASS-NAME is the name of the class. TREE is the class tree whose root is QUALIFIED-CLASS-NAME. QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. -The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." +The class tree is found in the buffer-local variable `ebrowse--tree-table'." (let (alist) (if qualified-names-p - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setq alist (cl-acons (ebrowse-qualified-class-name (ebrowse-ts-class tree)) tree alist))) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setq alist (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) tree alist)))) @@ -751,7 +700,7 @@ computes this information lazily." with result = nil as search = (pop to-search) while search finally return result - do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) + do (ebrowse-for-all-trees (ti ebrowse--tree-table) (when (memq search (ebrowse-ts-subclasses ti)) (unless (memq ti result) (setq result (nconc result (list ti)))) @@ -875,7 +824,7 @@ NOCONFIRM." "Create a new tree buffer for tree TREE. The tree was loaded from file TAGS-FILE. HEADER is the header structure of the file. -CLASSES is an obarray with a symbol for each class in the tree. +CLASSES is a hash-table with an entry for each class in the tree. POP non-nil means popup the buffer up at the end. Return the buffer created." (let ((name ebrowse-tree-buffer-name)) @@ -883,7 +832,7 @@ Return the buffer created." (ebrowse-tree-mode) (setq ebrowse--tree tree ebrowse--tags-file-name tags-file - ebrowse--tree-obarray classes + ebrowse--tree-table classes ebrowse--header header ebrowse--frozen-flag nil) (ebrowse-redraw-tree) @@ -895,13 +844,13 @@ Return the buffer created." -;;; Operations for member obarrays +;;; Operations for member tables (defun ebrowse-fill-member-table () - "Return an obarray holding all members of all classes in the current tree. + "Return a hash table holding all members of all classes in the current tree. -For each member, a symbol is added to the obarray. Members are -extracted from the buffer-local tree `ebrowse--tree-obarray'. +For each member, a symbol is added to the table. Members are +extracted from the buffer-local tree `ebrowse--tree-table'. Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST MEMBER) where TREE is the tree in which the member is defined, @@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member is found, and MEMBER is a MEMBER structure describing the member. The slot `member-table' of the buffer-local header structure of -type `ebrowse-hs' is set to the resulting obarray." +type `ebrowse-hs' is set to the resulting table." (let ((members (make-hash-table :test 'equal)) (i -1)) (setf (ebrowse-hs-member-table ebrowse--header) nil) (garbage-collect) ;; For all classes... - (ebrowse-for-all-trees (c ebrowse--tree-obarray) + (ebrowse-for-all-trees (c ebrowse--tree-table) (when (zerop (% (cl-incf i) 10)) (ebrowse-show-progress "Preparing member lookup" (zerop i))) (dolist (f ebrowse-member-list-accessors) (dolist (m (funcall f c)) - (let* ((member-name (ebrowse-ms-name m)) - (value (gethash member-name members))) - (push (list c f m) value) - (puthash member-name value members))))) + (push (list c f m) (gethash (ebrowse-ms-name m) members))))) (setf (ebrowse-hs-member-table ebrowse--header) members))) (defun ebrowse-member-table (header) - "Return the member obarray. Build it if it hasn't been set up yet. + "Return the member table. Build it if it hasn't been set up yet. HEADER is the tree header structure of the class tree." (when (null (ebrowse-hs-member-table header)) (cl-loop for buffer in (ebrowse-browser-buffer-list) @@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree." -;;; Operations on TREE obarrays +;;; Operations on TREE tables -(defun ebrowse-build-tree-obarray (tree) +(defun ebrowse-build-tree-table (tree) "Make sure every class in TREE is represented by a unique object. -Build obarray of all classes in TREE." - (let ((classes (make-vector 127 0))) +Build hash table of all classes in TREE." + (let ((classes (make-hash-table :test #'equal))) ;; Add root classes... (cl-loop for root in tree - as sym = - (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) - classes) - do (unless (get sym 'ebrowse-root) - (setf (get sym 'ebrowse-root) root))) + do (let ((name (ebrowse-qualified-class-name + (ebrowse-ts-class root)))) + (unless (gethash name classes) + (setf (gethash name classes) root)))) ;; Process subclasses (ebrowse-insert-supers tree classes) classes)) @@ -962,7 +907,7 @@ Build obarray of all classes in TREE." "Build base class lists in class tree TREE. CLASSES is an obarray used to collect classes. -Helper function for `ebrowse-build-tree-obarray'. Base classes should +Helper function for `ebrowse-build-tree-table'. Base classes should be ordered so that immediate base classes come first, then the base class of the immediate base class and so on. This means that we must construct the base-class list top down with adding each level at the @@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph." as subclasses = (ebrowse-ts-subclasses class) do ;; Make sure every class is represented by a unique object (cl-loop for subclass on subclasses - as sym = (intern - (ebrowse-qualified-class-name - (ebrowse-ts-class (car subclass))) - classes) do - ;; Replace the subclass tree with the one found in - ;; CLASSES if there is already an entry for that class - ;; in it. Otherwise make a new entry. - ;; - ;; CAVEAT: If by some means (e.g., use of the - ;; preprocessor in class declarations, a name is marked - ;; as a subclass of itself on some path, we would end up - ;; in an endless loop. We have to omit subclasses from - ;; the recursion that already have been processed. - (if (get sym 'ebrowse-root) - (setf (car subclass) (get sym 'ebrowse-root)) - (setf (get sym 'ebrowse-root) (car subclass)))) + (let ((name (ebrowse-qualified-class-name + (ebrowse-ts-class (car subclass))))) + ;; Replace the subclass tree with the one found in + ;; CLASSES if there is already an entry for that class + ;; in it. Otherwise make a new entry. + ;; + ;; CAVEAT: If by some means (e.g., use of the + ;; preprocessor in class declarations, a name is marked + ;; as a subclass of itself on some path, we would end up + ;; in an endless loop. We have to omit subclasses from + ;; the recursion that already have been processed. + (if (gethash name classes) + (setf (car subclass) (gethash name classes)) + (setf (gethash name classes) (car subclass))))) ;; Process subclasses (ebrowse-insert-supers subclasses classes))) @@ -1072,20 +1015,17 @@ Tree mode key bindings: (erase-buffer) (message nil)) - (set (make-local-variable 'ebrowse--show-file-names-flag) nil) - (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) - (set (make-local-variable 'ebrowse--frozen-flag) nil) + (setq-local ebrowse--show-file-names-flag nil) + (setq-local ebrowse--frozen-flag nil) (setq mode-line-buffer-identification ident) (setq buffer-read-only t) (add-to-invisibility-spec '(ebrowse . t)) - (set (make-local-variable 'revert-buffer-function) - #'ebrowse-revert-tree-buffer-from-file) - (set (make-local-variable 'ebrowse--header) header) - (set (make-local-variable 'ebrowse--tree) tree) - (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) - (set (make-local-variable 'ebrowse--tree-obarray) - (and tree (ebrowse-build-tree-obarray tree))) - (set (make-local-variable 'ebrowse--frozen-flag) nil) + (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file) + (setq-local ebrowse--header header) + (setq-local ebrowse--tree tree) + (setq-local ebrowse--tags-file-name buffer-file-name) + (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree))) + (setq-local ebrowse--frozen-flag nil) (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) @@ -1110,18 +1050,18 @@ Tree mode key bindings: (defun ebrowse-remove-class-and-kill-member-buffers (tree class) "Remove from TREE class CLASS. Kill all member buffers still containing a reference to the class." - (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) - ebrowse--tree-obarray))) - (setf tree (delq class tree) - (get sym 'ebrowse-root) nil) - (dolist (root tree) - (setf (ebrowse-ts-subclasses root) - (delq class (ebrowse-ts-subclasses root)) - (ebrowse-ts-base-classes root) nil) - (ebrowse-remove-class-and-kill-member-buffers - (ebrowse-ts-subclasses root) class)) - (ebrowse-kill-member-buffers-displaying class) - tree)) + (setf tree (delq class tree) + (gethash (ebrowse-cs-name (ebrowse-ts-class class)) + ebrowse--tree-table) + nil) + (dolist (root tree) + (setf (ebrowse-ts-subclasses root) + (delq class (ebrowse-ts-subclasses root)) + (ebrowse-ts-base-classes root) nil) + (ebrowse-remove-class-and-kill-member-buffers + (ebrowse-ts-subclasses root) class)) + (ebrowse-kill-member-buffers-displaying class) + tree) (defun ebrowse-remove-class-at-point (forced) @@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes." (defun ebrowse-mark-all-classes (prefix) "Unmark, with PREFIX mark, all classes in the tree." (interactive "P") - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setf (ebrowse-ts-mark tree) prefix)) (ebrowse-redraw-marks (point-min) (point-max))) @@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." "): ") nil nil ebrowse--indentation)))) (when (cl-plusp width) - (set (make-local-variable 'ebrowse--indentation) width) + (setq-local ebrowse--indentation width) (ebrowse-redraw-tree)))) @@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil." (unless class (setf class (completing-read "Goto class: " - (ebrowse-tree-obarray-as-alist) nil t))) + (ebrowse-tree-table-as-alist) nil t))) (goto-char (point-min)) (widen) (setq ebrowse--last-regexp (concat "\\b" class "\\b")) @@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil." (defun ebrowse-tree-command:show-member-variables (arg) "Display member variables; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg)) (defun ebrowse-tree-command:show-member-functions (&optional arg) "Display member functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg)) (defun ebrowse-tree-command:show-static-member-variables (arg) "Display static member variables; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg)) (defun ebrowse-tree-command:show-static-member-functions (arg) "Display static member functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg)) (defun ebrowse-tree-command:show-friends (arg) "Display friend functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-friends arg)) (defun ebrowse-tree-command:show-types (arg) "Display types defined in a class; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-types arg)) @@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame." (had-a-buf (get-file-buffer file)) (buf-to-view (find-file-noselect file))) (switch-to-buffer-other-frame buf-to-view) - (set (make-local-variable 'ebrowse--frame-configuration) + (setq-local ebrowse--frame-configuration old-frame-configuration) - (set (make-local-variable 'ebrowse--view-exit-action) + (setq-local ebrowse--view-exit-action (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) - 'kill-buffer)) + #'kill-buffer)) (view-mode-enter (cons (selected-window) (cons (selected-window) t)) 'ebrowse-view-exit-fn))) @@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch." (when (memq 'mode-name mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) - (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq-local Helper-return-blurb "return to buffer editing") (setq truncate-lines t buffer-read-only t)) @@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION." (define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" "Major mode for Ebrowse member buffers." (mapc #'make-local-variable - '(ebrowse--decl-column ;display column - ebrowse--n-columns ;number of short columns - ebrowse--column-width ;width of columns above - ebrowse--show-inherited-flag ;include inherited members? - ebrowse--filters ;public, protected, private + '(ebrowse--n-columns ;number of short columns ebrowse--accessor ;vars, functions, friends ebrowse--displayed-class ;class displayed - ebrowse--long-display-flag ;display with regexps? - ebrowse--source-regexp-flag ;show source regexp? - ebrowse--attributes-flag ;show `virtual' and `inline' ebrowse--member-list ;list of members displayed ebrowse--tree ;the class tree ebrowse--member-mode-strings ;part of mode line ebrowse--tags-file-name ; ebrowse--header - ebrowse--tree-obarray - ebrowse--virtual-display-flag - ebrowse--inline-display-flag - ebrowse--const-display-flag - ebrowse--pure-display-flag + ebrowse--tree-table ebrowse--frozen-flag)) ;buffer not automagically reused - (setq mode-line-buffer-identification - (propertized-buffer-identification "C++ Members") - buffer-read-only t - ebrowse--long-display-flag nil - ebrowse--attributes-flag t - ebrowse--show-inherited-flag t - ebrowse--source-regexp-flag nil - ebrowse--filters [0 1 2] - ebrowse--decl-column ebrowse-default-declaration-column - ebrowse--column-width ebrowse-default-column-width - ebrowse--virtual-display-flag nil - ebrowse--inline-display-flag nil - ebrowse--const-display-flag nil - ebrowse--pure-display-flag nil) + (setq-local + mode-line-buffer-identification + (propertized-buffer-identification "C++ Members") + buffer-read-only t + ebrowse--long-display-flag nil ;display with regexps? + ebrowse--attributes-flag t ;show `virtual' and `inline' + ebrowse--show-inherited-flag t ;include inherited members? + ebrowse--source-regexp-flag nil ;show source regexp? + ebrowse--filters [0 1 2] ;public, protected, private + ebrowse--decl-column ebrowse-default-declaration-column ;display column + ebrowse--column-width ebrowse-default-column-width ;width of columns above + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil + ebrowse--const-display-flag nil + ebrowse--pure-display-flag nil) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) @@ -2257,10 +2187,10 @@ make one." (ebrowse-create-tree-buffer ebrowse--tree ebrowse--tags-file-name ebrowse--header - ebrowse--tree-obarray + ebrowse--tree-table 'pop)))) (and buf - (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) + (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf)) buf)) @@ -2276,8 +2206,9 @@ make one." (defun ebrowse-cyclic-display-next/previous-member-list (incr) "Switch buffer to INCR'th next/previous list of members." - (let ((index (ebrowse-position ebrowse--accessor - ebrowse-member-list-accessors))) + (let ((index (seq-position ebrowse-member-list-accessors + ebrowse--accessor + #'eql))) (setf ebrowse--accessor (cond ((cl-plusp incr) (or (nth (1+ index) @@ -2306,37 +2237,37 @@ make one." (defun ebrowse-display-function-member-list () "Display the list of member functions." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions)) (defun ebrowse-display-variables-member-list () "Display the list of member variables." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables)) (defun ebrowse-display-static-variables-member-list () "Display the list of static member variables." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables)) (defun ebrowse-display-static-functions-member-list () "Display the list of static member functions." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions)) (defun ebrowse-display-friends-member-list () "Display the list of friends." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends)) (defun ebrowse-display-types-member-list () "Display the list of types." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types)) @@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file." "Force buffer redisplay." (interactive) (let ((display-fn (if ebrowse--long-display-flag - 'ebrowse-draw-member-long-fn - 'ebrowse-draw-member-short-fn))) + #'ebrowse-draw-member-long-fn + #'ebrowse-draw-member-short-fn))) (with-silent-modifications (erase-buffer) ;; Show this class @@ -2610,7 +2541,7 @@ the class cursor is on." "Start point for member buffer creation. LIST is the member list to display. STAND-ALONE non-nil means the member buffer is standalone. CLASS is its class." - (let* ((classes ebrowse--tree-obarray) + (let* ((classes ebrowse--tree-table) (tree ebrowse--tree) (tags-file ebrowse--tags-file-name) (header ebrowse--header) @@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class." (setq ebrowse--member-list (funcall list class) ebrowse--displayed-class class ebrowse--accessor list - ebrowse--tree-obarray classes + ebrowse--tree-table classes ebrowse--frozen-flag stand-alone ebrowse--tags-file-name tags-file ebrowse--header header @@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times." (cl-defun ebrowse-move-point-to-member (name &optional count &aux member) - "Set point on member NAME in the member buffer + "Set point on member NAME in the member buffer. COUNT, if specified, says search the COUNT'th member with the same name." (goto-char (point-min)) (widen) @@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use." (class (or (ebrowse-completing-read-value title compl-list initial) (error "Not found")))) (setf ebrowse--displayed-class class - ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + ebrowse--member-list (funcall ebrowse--accessor + ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))) @@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use." "Switch member buffer to a class read from the minibuffer." (interactive) (ebrowse-switch-member-buffer-to-other-class - "Goto class: " (ebrowse-tree-obarray-as-alist))) + "Goto class: " + ;; FIXME: Why not use the hash-table as-is? + (ebrowse-tree-table-as-alist))) (defun ebrowse-switch-member-buffer-to-base-class (arg) @@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one." (cl-first supers)))) (unless tree (error "Not found")) (setq containing-list (ebrowse-ts-subclasses tree))))) - (setq index (+ inc (ebrowse-position ebrowse--displayed-class - containing-list))) + (setq index (+ inc (seq-position containing-list + ebrowse--displayed-class + #'eql))) (cond ((cl-minusp index) (message "No previous class")) ((null (nth index containing-list)) (message "No next class"))) (setq index (max 0 (min index (1- (length containing-list))))) @@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one." Prefix arg ARG says which class should be displayed. Default is the first derived class." (interactive "P") - (cl-flet ((ebrowse-tree-obarray-as-alist () + (cl-flet ((ebrowse-tree-table-as-alist () (cl-loop for s in (ebrowse-ts-subclasses ebrowse--displayed-class) - collect (cons (ebrowse-cs-name - (ebrowse-ts-class s)) s)))) + collect (cons (ebrowse-cs-name (ebrowse-ts-class s)) + s)))) (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) (error "No derived classes")))) (if (and arg (cl-second subs)) (ebrowse-switch-member-buffer-to-other-class - "Goto derived class: " (ebrowse-tree-obarray-as-alist)) + "Goto derived class: " (ebrowse-tree-table-as-alist)) (setq ebrowse--displayed-class (cl-first subs) ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) @@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)." (switch-to-buffer buffer) (setq ebrowse--displayed-class (cl-first info) ebrowse--accessor (cl-second info) - ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + ebrowse--member-list (funcall ebrowse--accessor + ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))) (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) @@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer." (_ "unknown")) "\n"))) -(defvar ebrowse-last-completion nil +(defvar-local ebrowse-last-completion nil "Text inserted by the last completion operation.") -(defvar ebrowse-last-completion-start nil +(defvar-local ebrowse-last-completion-start nil "String which was the basis for the last completion operation.") -(defvar ebrowse-last-completion-location nil +(defvar-local ebrowse-last-completion-location nil "Buffer position at which the last completion operation was initiated.") -(defvar ebrowse-last-completion-obarray nil +(defvar-local ebrowse-last-completion-table nil "Member used in last completion operation.") - - -(make-variable-buffer-local 'ebrowse-last-completion-obarray) -(make-variable-buffer-local 'ebrowse-last-completion-location) -(make-variable-buffer-local 'ebrowse-last-completion) -(make-variable-buffer-local 'ebrowse-last-completion-start) - - (defun ebrowse-some-member-table () "Return a hash table containing all members of a tree. @@ -3552,7 +3480,7 @@ use choose a tree." (defun ebrowse-cyclic-successor-in-string-list (string list) "Return the item following STRING in LIST. If STRING is the last element, return the first element as successor." - (or (nth (1+ (ebrowse-position string list 'string=)) list) + (or (nth (1+ (seq-position list string #'string=)) list) (cl-first list))) @@ -3583,7 +3511,7 @@ completion." ;; expansion ended, insert the next expansion. ((eq (point) ebrowse-last-completion-location) (setf list (all-completions ebrowse-last-completion-start - ebrowse-last-completion-obarray) + ebrowse-last-completion-table) completion (ebrowse-cyclic-successor-in-string-list ebrowse-last-completion list)) (cond ((null completion) @@ -3599,7 +3527,7 @@ completion." ;; buffer: Start new completion. (t (let* ((members (ebrowse-some-member-table)) - (completion (cl-first (all-completions pattern members nil)))) + (completion (cl-first (all-completions pattern members)))) (cond ((eq completion t)) ((null completion) (error "Can't find completion for `%s'" pattern)) @@ -3610,14 +3538,14 @@ completion." (setf ebrowse-last-completion-location (point) ebrowse-last-completion-start pattern ebrowse-last-completion completion - ebrowse-last-completion-obarray members)))))))) + ebrowse-last-completion-table members)))))))) ;;; Tags query replace & search -(defvar ebrowse-tags-loop-form () - "Form for `ebrowse-loop-continue'. -Evaluated for each file in the tree. If it returns nil, proceed +(defvar ebrowse-tags-loop-call '(ignore) + "Function call for `ebrowse-loop-continue'. +Passed to `apply' for each file in the tree. If it returns nil, proceed with the next file.") (defvar ebrowse-tags-next-file-list () @@ -3684,7 +3612,7 @@ TREE-BUFFER if indirectly specifies which files to loop over." (when first-time (ebrowse-tags-next-file first-time tree-buffer) (goto-char (point-min))) - (while (not (eval ebrowse-tags-loop-form)) + (while (not (apply ebrowse-tags-loop-call)) (ebrowse-tags-next-file) (message "Scanning file `%s'..." buffer-file-name) (goto-char (point-min)))) @@ -3697,9 +3625,9 @@ If marked classes exist, process marked classes, only. If regular expression is nil, repeat last search." (interactive "sTree search (regexp): ") (if (and (string= regexp "") - (eq (car ebrowse-tags-loop-form) 're-search-forward)) + (eq (car ebrowse-tags-loop-call) #'re-search-forward)) (ebrowse-tags-loop-continue) - (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + (setq ebrowse-tags-loop-call `(re-search-forward ,regexp nil t)) (ebrowse-tags-loop-continue 'first-time))) @@ -3709,10 +3637,11 @@ If regular expression is nil, repeat last search." With prefix arg, process files of marked classes only." (interactive "sTree query replace (regexp): \nsTree query replace %s by: ") - (setq ebrowse-tags-loop-form - (list 'and (list 'save-excursion - (list 're-search-forward from nil t)) - (list 'not (list 'perform-replace from to t t nil)))) + (setq ebrowse-tags-loop-call + (list (lambda () + (and (save-excursion + (re-search-forward from nil t)) + (not (perform-replace from to t t nil)))))) (ebrowse-tags-loop-continue 'first-time)) @@ -3737,7 +3666,7 @@ looks like a function call to the member." (cl-values-list (ebrowse-tags-read-name header "Find calls of: ")))) ;; Set tags loop form to search for member and begin loop. (setq regexp (concat "\\<" name "[ \t]*(") - ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + ebrowse-tags-loop-call `(re-search-forward ,regexp nil t)) (ebrowse-tags-loop-continue 'first-time tree-buffer)))) @@ -3746,7 +3675,7 @@ looks like a function call to the member." ;;; Structures of this kind are the elements of the position stack. -(cl-defstruct (ebrowse-position (:type vector) :named) +(cl-defstruct (ebrowse-position) file-name ; in which file point ; point in file target ; t if target of a jump @@ -3839,18 +3768,10 @@ Prefix arg ARG says how much." ;;; Electric position list -(defvar ebrowse-electric-position-mode-map () - "Keymap used in electric position stack window.") - - -(defvar ebrowse-electric-position-mode-hook nil - "If non-nil, its value is called by `ebrowse-electric-position-mode'.") - - -(unless ebrowse-electric-position-mode-map +(defvar ebrowse-electric-position-mode-map (let ((map (make-keymap)) (submap (make-keymap))) - (setq ebrowse-electric-position-mode-map map) + ;; FIXME: Yuck! (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) (define-key map "\e" submap) @@ -3873,14 +3794,19 @@ Prefix arg ARG says how much." (define-key map "\e\C-v" 'scroll-other-window) (define-key map "\e>" 'end-of-buffer) (define-key map "\e<" 'beginning-of-buffer) - (define-key map "\e>" 'end-of-buffer))) + (define-key map "\e>" 'end-of-buffer) + map) + "Keymap used in electric position stack window.") + + +(defvar ebrowse-electric-position-mode-hook nil + "If non-nil, its value is called by `ebrowse-electric-position-mode'.") -(put 'ebrowse-electric-position-mode 'mode-class 'special) (put 'ebrowse-electric-position-undefined 'suppress-keymap t) (define-derived-mode ebrowse-electric-position-mode - fundamental-mode "Electric Position Menu" + special-mode "Electric Position Menu" "Mode for electric position buffers. Runs the hook `ebrowse-electric-position-mode-hook'." (setq mode-line-buffer-identification "Electric Position Menu") @@ -3888,7 +3814,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'." (setq mode-line-format (copy-sequence mode-line-format)) ;; FIXME: Why not set `mode-name' to "Positions"? (setcar (memq 'mode-name mode-line-format) "Positions")) - (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq-local Helper-return-blurb "return to buffer editing") (setq truncate-lines t buffer-read-only t)) @@ -4101,7 +4027,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS NUMBER-OF-STATIC-VARIABLES:" (let ((classes 0) (member-functions 0) (member-variables 0) (static-functions 0) (static-variables 0)) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (cl-incf classes) (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) @@ -4391,10 +4317,4 @@ EVENT is the mouse event." (provide 'ebrowse) - -;; Local variables: -;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) -;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) -;; End: - ;;; ebrowse.el ends here diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index f39ecf9b7bc..72b94a57b4a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -231,8 +231,35 @@ Comments in the form will be lost." (setq-local electric-pair-text-pairs elisp-pairs))))) (remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs)) +(defun elisp-enable-lexical-binding (&optional interactive) + "Make the current buffer use `lexical-binding'." + (interactive "p") + (if lexical-binding + (when interactive + (message "lexical-binding already enabled!") + (ding)) + (when (or (not interactive) + (y-or-n-p (format "Enable lexical-binding in this %s? " + (if buffer-file-name "file" "buffer")))) + (setq-local lexical-binding t) + (add-file-local-variable-prop-line 'lexical-binding t interactive)))) + +(defvar elisp--dynlex-modeline-map + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'elisp-enable-lexical-binding) + map)) + ;;;###autoload -(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" +(define-derived-mode emacs-lisp-mode lisp-data-mode + `("ELisp" + (lexical-binding (:propertize "/l" + help-echo "Using lexical-binding mode") + (:propertize "/d" + help-echo "Using old dynamic scoping mode\n\ +mouse-1: Enable lexical-binding mode" + face warning + mouse-face mode-line-highlight + local-map ,elisp--dynlex-modeline-map))) "Major mode for editing Lisp code to run in Emacs. Commands: Delete converts tabs to spaces as it moves back. @@ -241,35 +268,28 @@ Blank lines separate paragraphs. Semicolons start comments. \\{emacs-lisp-mode-map}" :group 'lisp (defvar project-vc-external-roots-function) - (lisp-mode-variables nil nil 'elisp) + (setcar font-lock-defaults + '(lisp-el-font-lock-keywords + lisp-el-font-lock-keywords-1 + lisp-el-font-lock-keywords-2)) + (setf (nth 2 font-lock-defaults) nil) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) (if (boundp 'electric-pair-text-pairs) (setq-local electric-pair-text-pairs - (append '((?\` . ?\') (?‘ . ?’)) + (append '((?\` . ?\') (?\‘ . ?\’)) electric-pair-text-pairs)) (add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs)) - (setq-local electric-quote-string t) - (setq imenu-case-fold-search nil) - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function) + (add-hook 'eldoc-documentation-functions + #'elisp-eldoc-funcall nil t) + (add-hook 'eldoc-documentation-functions + #'elisp-eldoc-var-docstring nil t) (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local) - ;; .dir-locals.el and lock files will cause the byte-compiler and - ;; checkdoc emit spurious warnings, because they don't follow the - ;; conventions of Emacs Lisp sources. Until we have a better fix, - ;; like teaching elisp-mode about files that only hold data - ;; structures, we disable the ELisp Flymake backend for these files. - (unless - (let* ((bfname (buffer-file-name)) - (fname (and (stringp bfname) (file-name-nondirectory bfname)))) - (and (stringp fname) - (or (string-match "\\`\\.#" fname) - (string-equal dir-locals-file fname)))) - (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) - (add-hook 'flymake-diagnostic-functions - #'elisp-flymake-byte-compile nil t))) + (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) + (add-hook 'flymake-diagnostic-functions + #'elisp-flymake-byte-compile nil t)) ;; Font-locking support. @@ -637,18 +657,16 @@ functions are annotated with \"<f>\" via the ;; WORKAROUND: This is nominally a constant, but the text properties ;; are not preserved thru dump if use defconst. See bug#21237. (defvar elisp--xref-format - (let ((str "(%s %s)")) - (put-text-property 1 3 'face 'font-lock-keyword-face str) - (put-text-property 4 6 'face 'font-lock-function-name-face str) - str)) + #("(%s %s)" + 1 3 (face font-lock-keyword-face) + 4 6 (face font-lock-function-name-face))) ;; WORKAROUND: This is nominally a constant, but the text properties ;; are not preserved thru dump if use defconst. See bug#21237. (defvar elisp--xref-format-extra - (let ((str "(%s %s %s)")) - (put-text-property 1 3 'face 'font-lock-keyword-face str) - (put-text-property 4 6 'face 'font-lock-function-name-face str) - str)) + #("(%s %s %s)" + 1 3 (face font-lock-keyword-face) + 4 6 (face font-lock-function-name-face))) (defvar find-feature-regexp);; in find-func.el @@ -845,11 +863,12 @@ non-nil result supercedes the xrefs produced by xrefs)) -(declare-function project-external-roots "project") +(declare-function xref-apropos-regexp "xref" (pattern)) -(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp) +(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern) (apply #'nconc - (let (lst) + (let ((regexp (xref-apropos-regexp pattern)) + lst) (dolist (sym (apropos-internal regexp)) (push (elisp--xref-find-definitions sym) lst)) (nreverse lst)))) @@ -1386,20 +1405,29 @@ which see." or argument string for functions. 2 - `function' if function args, `variable' if variable documentation.") -(defun elisp-eldoc-documentation-function () - "`eldoc-documentation-function' (which see) for Emacs Lisp." - (let ((current-symbol (elisp--current-symbol)) - (current-fnsym (elisp--fnsym-in-current-sexp))) - (cond ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply #'elisp-get-fnsym-args-string current-fnsym) - (elisp-get-var-docstring current-symbol))) - (t - (or (elisp-get-var-docstring current-symbol) - (apply #'elisp-get-fnsym-args-string current-fnsym)))))) - -(defun elisp-get-fnsym-args-string (sym &optional index prefix) +(defun elisp-eldoc-funcall (callback &rest _ignored) + "Document function call at point. +Intended for `eldoc-documentation-functions' (which see)." + (let* ((sym-info (elisp--fnsym-in-current-sexp)) + (fn-sym (car sym-info))) + (when fn-sym + (funcall callback (apply #'elisp-get-fnsym-args-string sym-info) + :thing fn-sym + :face (if (functionp fn-sym) + 'font-lock-function-name-face + 'font-lock-keyword-face))))) + +(defun elisp-eldoc-var-docstring (callback &rest _ignored) + "Document variable at point. +Intended for `eldoc-documentation-functions' (which see)." + (let* ((sym (elisp--current-symbol)) + (docstring (and sym (elisp-get-var-docstring sym)))) + (when docstring + (funcall callback docstring + :thing sym + :face 'font-lock-variable-name-face)))) + +(defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. If SYM is a subr and no arglist is obtainable from the docstring or elsewhere, return a 1-line docstring." @@ -1425,20 +1453,13 @@ or elsewhere, return a 1-line docstring." ;; Stringify, and store before highlighting, downcasing, etc. (elisp--last-data-store sym (elisp-function-argstring args) 'function)))))) - ;; Highlight, truncate. + ;; Highlight (if argstring (elisp--highlight-function-argument - sym argstring index - (or prefix - (concat (propertize (symbol-name sym) 'face - (if (functionp sym) - 'font-lock-function-name-face - 'font-lock-keyword-face)) - ": ")))))) - -(defun elisp--highlight-function-argument (sym args index prefix) - "Highlight argument INDEX in ARGS list for function SYM. -In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." + sym argstring index)))) + +(defun elisp--highlight-function-argument (sym args index) + "Highlight argument INDEX in ARGS list for function SYM." ;; FIXME: This should probably work on the list representation of `args' ;; rather than its string representation. ;; FIXME: This function is much too long, we need to split it up! @@ -1541,7 +1562,6 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (when start (setq doc (copy-sequence args)) (add-text-properties start end (list 'face argument-face) doc)) - (setq doc (eldoc-docstring-format-sym-doc prefix doc)) doc))) ;; Return a string containing a brief (one-line) documentation string for @@ -1554,9 +1574,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (t (let ((doc (documentation-property sym 'variable-documentation t))) (when doc - (let ((doc (eldoc-docstring-format-sym-doc - sym (elisp--docstring-first-line doc) - 'font-lock-variable-name-face))) + (let ((doc (elisp--docstring-first-line doc))) (elisp--last-data-store sym doc 'variable))))))) (defun elisp--last-data-store (symbol doc type) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 897f105019e..81cb2b7cd77 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -292,7 +292,7 @@ file the tag was in." (or (locate-dominating-file default-directory "TAGS") default-directory))) (list (read-file-name - "Visit tags table (default TAGS): " + (format-prompt "Visit tags table" "TAGS") ;; default to TAGS from default-directory up to root. default-tag-dir (expand-file-name "TAGS" default-tag-dir) @@ -625,7 +625,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (car list)) ;; Finally, prompt the user for a file name. (expand-file-name - (read-file-name "Visit tags table (default TAGS): " + (read-file-name (format-prompt "Visit tags table" "TAGS") default-directory "TAGS" t)))))) @@ -1424,6 +1424,10 @@ hits the start of file." (goto-func goto-tag-location-function) tag tag-info pt) (forward-line 1) + ;; Exuberant ctags add a line starting with the DEL character; + ;; skip past it. + (when (looking-at "\177") + (forward-line 1)) (while (not (or (eobp) (looking-at "\f"))) ;; We used to use explicit tags when available, but the current goto-func ;; can only handle implicit tags. @@ -2080,8 +2084,8 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol) (etags--xref-find-definitions symbol)) -(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol) - (etags--xref-find-definitions symbol t)) +(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern) + (etags--xref-find-definitions (xref-apropos-regexp pattern) t)) (defun etags--xref-find-definitions (pattern &optional regexp?) ;; This emulates the behavior of `find-tag-in-order' but instead of diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el index bddd1a39fc2..19565ef9b13 100644 --- a/lisp/progmodes/flymake-cc.el +++ b/lisp/progmodes/flymake-cc.el @@ -5,18 +5,20 @@ ;; Author: João Távora <joaotavora@gmail.com> ;; Keywords: languages, c -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 1ed733b7e37..bdb775795ab 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,9 +4,12 @@ ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> ;; Maintainer: João Távora <joaotavora@gmail.com> -;; Version: 1.0.8 -;; Package-Requires: ((emacs "26.1")) +;; Version: 1.0.9 ;; Keywords: c languages tools +;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) + +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. @@ -999,6 +1002,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'after-change-functions 'flymake-after-change-function nil t) (add-hook 'after-save-hook 'flymake-after-save-hook nil t) (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t) ;; If Flymake happened to be alrady already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly @@ -1016,6 +1020,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (remove-hook 'after-save-hook 'flymake-after-save-hook t) (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) + (remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t) (mapc #'delete-overlay (flymake--overlays)) @@ -1083,6 +1088,14 @@ START and STOP and LEN are as in `after-change-functions'." (flymake-mode) (flymake-log :warning "Turned on in `flymake-find-file-hook'"))) +(defun flymake-eldoc-function (report-doc &rest _) + "Document diagnostics at point. +Intended for `eldoc-documentation-functions' (which see)." + (let ((diags (flymake-diagnostics (point)))) + (when diags + (funcall report-doc + (mapconcat #'flymake-diagnostic-text diags "\n"))))) + (defun flymake-goto-next-error (&optional n filter interactive) "Go to Nth next Flymake diagnostic that matches FILTER. Interactively, always move to the next diagnostic. With a prefix diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 811951eaaaf..abc860b9478 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -429,7 +429,7 @@ The only difference is, it returns t in a case when the default returns nil." fortran-font-lock-keywords-1 ;; All type specifiers plus their declared items. (list - (list (concat fortran-type-types "[ \t(/]*\\(*\\)?") + (list (concat fortran-type-types "[ \t(/]*\\(\\*\\)?") ;; Type specifier. '(1 font-lock-type-face) ;; Declaration item (or just /.../ block name). diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e785acd2840..c1184211d06 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -92,6 +92,8 @@ (require 'json) (require 'bindat) (require 'cl-lib) +(require 'cl-seq) +(eval-when-compile (require 'pcase)) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -105,13 +107,24 @@ (defvar speedbar-initial-expansion-list-name) (defvar speedbar-frame) -(defvar gdb-memory-address "main") -(defvar gdb-memory-last-address nil +(defvar-local gdb-memory-address-expression "main" + "This expression is passed to gdb. +Possible value: main, $rsp, x+3.") +(defvar-local gdb-memory-address nil + "Address of memory display.") +(defvar-local gdb-memory-last-address nil "Last successfully accessed memory address.") (defvar gdb-memory-next-page nil "Address of next memory page for program memory buffer.") (defvar gdb-memory-prev-page nil "Address of previous memory page for program memory buffer.") +(defvar-local gdb--memory-display-warning nil + "Display warning on memory header if t. + +When error occurs when retrieving memory, gdb-mi displays the +last successful page. In that case the expression might not +match the memory displayed. We want to let the user be aware of +that, so display a warning exclamation mark in the header line.") (defvar gdb-thread-number nil "Main current thread. @@ -211,7 +224,9 @@ Only used for files that Emacs can't find.") (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) -(defvar gdb-source-window nil) +(defvar gdb-source-window-list nil + "List of windows used for displaying source files. +Sorted in most-recently-visited-first order.") (defvar gdb-inferior-status nil) (defvar gdb-continuation nil) (defvar gdb-supports-non-stop nil) @@ -242,6 +257,27 @@ Possible values are these symbols: disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") +(defvar gdb--window-configuration-before nil + "Stores the window configuration before starting GDB.") + +(defcustom gdb-restore-window-configuration-after-quit nil + "If non-nil, restore window configuration as of before GDB started. + +Possible values are: + t -- Always restore. + nil -- Don't restore. + `if-gdb-show-main' -- Restore only if variable `gdb-show-main' + is non-nil + `if-gdb-many-windows' -- Restore only if variable `gdb-many-windows' + is non-nil." + :type '(choice + (const :tag "Always restore" t) + (const :tag "Don't restore" nil) + (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main) + (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows)) + :group 'gdb + :version "28.1") + (defcustom gdb-discard-unordered-replies t "Non-nil means discard any out-of-order GDB replies. This protects against lost GDB replies, assuming that GDB always @@ -592,6 +628,40 @@ Also display the main routine in the disassembly buffer if present." :group 'gdb :version "22.1") +(defcustom gdb-window-configuration-directory user-emacs-directory + "Directory where GDB window configuration files are stored. +If nil, use `default-directory'." + :type 'string + :group 'gdb + :version "28.1") + +(defcustom gdb-default-window-configuration-file nil + "If non-nil, load this window configuration (layout) on startup. +This should be the full name of the window configuration file. +If this is not an absolute path, GDB treats it as a relative path +and looks under `gdb-window-configuration-directory'. + +Note that this variable only takes effect when variable +`gdb-many-windows' is t." + :type 'string + :group 'gdb + :version "28.1") + +(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window . t))) + "`display-buffer' action used when GDB displays a source buffer." + :type 'list + :group 'gdb + :version "28.1") + +(defcustom gdb-max-source-window-count 1 + "Maximum number of source windows to use. +Until there are such number of source windows on screen, GDB +tries to open a new window when visiting a new source file; after +that GDB starts to reuse existing source windows." + :type 'number + :group 'gdb + :version "28.1") + (defvar gdbmi-debug-mode nil "When non-nil, print the messages sent/received from GDB/MI in *Messages*.") @@ -750,6 +820,12 @@ detailed description of this mode. (gdb-restore-windows) (error "Multiple debugging requires restarting in text command mode")) + + ;; Save window configuration before starting gdb so we can restore + ;; it after gdb quits. Save it regardless of the value of + ;; `gdb-restore-window-configuration-after-quit'. + (setq gdb--window-configuration-before (window-state-get)) + ;; (gud-common-init command-line nil 'gud-gdbmi-marker-filter) @@ -925,7 +1001,7 @@ detailed description of this mode. gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) gdb-debug-log nil - gdb-source-window nil + gdb-source-window-list nil gdb-inferior-status nil gdb-continuation nil gdb-buf-publisher '() @@ -1035,7 +1111,10 @@ no input, and GDB is waiting for input." (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) -(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"") +(defconst gdb--string-regexp (rx "\"" + (* (or (seq "\\" nonl) + (not (any "\"\\")))) + "\"")) (defun gdb-tooltip-print (expr) (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) @@ -1667,25 +1746,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with "Interrupt the program being debugged." (interactive) (interrupt-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-quit () "Send quit signal to the program being debugged." (interactive) (quit-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-stop () "Stop the program being debugged." (interactive) (stop-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) (defun gdb-io-eof () "Send end-of-file to the program being debugged." (interactive) (process-send-eof - (get-buffer-process gud-comint-buffer))) + (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)))) (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) @@ -1788,7 +1867,8 @@ static char *magick[] = { "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" gdb-python-guile-commands-regexp "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" - "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$") + "\\|expl\\(o\\(re?\\)?\\)?" + "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$") "Regexp matching GDB commands that enter a recursive reading loop. As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") @@ -2007,17 +2087,36 @@ is running." ;; GDB frame (after up, down etc). If no GDB frame is visible but the last ;; visited breakpoint is, use that window. (defun gdb-display-source-buffer (buffer) - (let* ((last-window (if gud-last-last-frame - (get-buffer-window - (gud-find-file (car gud-last-last-frame))))) - (source-window (or last-window - (if (and gdb-source-window - (window-live-p gdb-source-window)) - gdb-source-window)))) - (when source-window - (setq gdb-source-window source-window) - (set-window-buffer source-window buffer)) - source-window)) + "Find a window to display BUFFER. +Always find a window to display buffer, and return it." + ;; This function doesn't take care of setting up source window(s) at startup, + ;; that's handled by `gdb-setup-windows' (if `gdb-many-windows' is non-nil). + ;; If `buffer' is already shown in a window, use that window. + (or (get-buffer-window buffer) + (progn + ;; First, update the window list. + (setq gdb-source-window-list + (cl-remove-duplicates + (cl-remove-if-not + (lambda (win) + (and (window-live-p win) + (eq (window-frame win) + (selected-frame)))) + gdb-source-window-list))) + ;; Should we create a new window or reuse one? + (if (> gdb-max-source-window-count + (length gdb-source-window-list)) + ;; Create a new window, push it to window list and return it. + (car (push (display-buffer buffer gdb-display-source-buffer-action) + gdb-source-window-list)) + ;; Reuse a window, we use the oldest window and put that to + ;; the front of the window list. + (let ((last-win (car (last gdb-source-window-list))) + (rest (butlast gdb-source-window-list))) + (set-window-buffer last-win buffer) + (setq gdb-source-window-list + (cons last-win rest)) + last-win))))) (defun gdbmi-start-with (str offset match) @@ -2446,7 +2545,13 @@ file names include non-ASCII characters." gdb-filter-output) -(defun gdb-gdb (_output-field)) +(defun gdb-gdb (_output-field) + ;; This is needed because the "explore" command is not ended by the + ;; likes of "end" or "quit", but instead by a RET at the approriate + ;; place, and we know we have exited "explore" when we get the + ;; "(gdb)" prompt. + (and (> gdb-control-level 0) + (setq gdb-control-level (1- gdb-control-level)))) (defun gdb-shell (output-field) (setq gdb-filter-output @@ -3450,7 +3555,7 @@ line." (def-gdb-trigger-and-handler gdb-invalidate-memory (format "-data-read-memory %s %s %d %d %d" - gdb-memory-address + (gdb-mi-quote gdb-memory-address-expression) gdb-memory-format gdb-memory-unit gdb-memory-rows @@ -3490,6 +3595,9 @@ in `gdb-memory-format'." (err-msg (bindat-get-field res 'msg))) (if (not err-msg) (let ((memory (bindat-get-field res 'memory))) + (when gdb-memory-last-address + ;; Nil means last retrieve emits error or just started the session. + (setq gdb--memory-display-warning nil)) (setq gdb-memory-address (bindat-get-field res 'addr)) (setq gdb-memory-next-page (bindat-get-field res 'next-page)) (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) @@ -3503,10 +3611,15 @@ in `gdb-memory-format'." gdb-memory-format))))) (newline))) ;; Show last page instead of empty buffer when out of bounds - (progn - (let ((gdb-memory-address gdb-memory-last-address)) + (when gdb-memory-last-address + (let ((gdb-memory-address-expression gdb-memory-last-address)) + ;; If we don't set `gdb-memory-last-address' to nil, + ;; `gdb-invalidate-memory' eventually calls + ;; `gdb-read-memory-custom', making an infinite loop. + (setq gdb-memory-last-address nil + gdb--memory-display-warning t) (gdb-invalidate-memory 'update) - (error err-msg)))))) + (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg)))))) (defvar gdb-memory-mode-map (let ((map (make-sparse-keymap))) @@ -3540,7 +3653,7 @@ in `gdb-memory-format'." "Set the start memory address." (interactive) (let ((arg (read-from-minibuffer "Memory address: "))) - (setq gdb-memory-address arg)) + (setq gdb-memory-address-expression arg)) (gdb-invalidate-memory 'update)) (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) @@ -3723,7 +3836,19 @@ DOC is an optional documentation string." (defvar gdb-memory-header '(:eval (concat - "Start address[" + "Start address " + ;; If `gdb-memory-address-expression' is nil, `propertize' would error. + (propertize (or gdb-memory-address-expression "N/A") + 'face font-lock-warning-face + 'help-echo "mouse-1: set start address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-address-event)) + (if gdb--memory-display-warning + (propertize " !" 'face '(:inherit error :weight bold)) + "") + " [" (propertize "-" 'face font-lock-warning-face 'help-echo "mouse-1: decrement address" @@ -3740,13 +3865,9 @@ DOC is an optional documentation string." 'mouse-1 #'gdb-memory-show-next-page)) "]: " - (propertize gdb-memory-address - 'face font-lock-warning-face - 'help-echo "mouse-1: set start address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-set-address-event)) + ;; If `gdb-memory-address' is nil, `propertize' would error. + (propertize (or gdb-memory-address "N/A") + 'face font-lock-warning-face) " Rows: " (propertize (number-to-string gdb-memory-rows) 'face font-lock-warning-face @@ -3986,9 +4107,7 @@ DOC is an optional documentation string." (let* ((buffer (find-file-noselect (if (file-exists-p file) file (cdr (assoc bptno gdb-location-alist))))) - (window (or (gdb-display-source-buffer buffer) - (display-buffer buffer)))) - (setq gdb-source-window window) + (window (gdb-display-source-buffer buffer))) (with-current-buffer buffer (goto-char (point-min)) (forward-line (1- (string-to-number line))) @@ -4464,6 +4583,26 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key gud-menu-map [displays] `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdbmi))) + (define-key menu [gdb-restore-windows] + '(menu-item "Restore Initial Layout" gdb-restore-windows + :help "Restore the initial GDB window layout.")) + ;; Window layout vs window configuration: We use "window layout" in + ;; GDB UI. Internally we refer to "window configuration" because + ;; that's the data structure used to store window layouts. Though + ;; bare in mind that there is a small difference between what we + ;; store and what normal window configuration functions + ;; output. Because GDB buffers (source, local, breakpoint, etc) are + ;; different between each debugging sessions, simply save/load + ;; window configurations doesn't + ;; work. `gdb-save-window-configuration' and + ;; `gdb-load-window-configuration' do some tricks to store and + ;; recreate each buffer in the layout. + (define-key menu [load-layout] '("Load Layout" "Load GDB window configuration (layout) from a file" . gdb-load-window-configuration)) + (define-key menu [save-layout] '("Save Layout" "Save current GDB window configuration (layout) to a file" . gdb-save-window-configuration)) + (define-key menu [restore-layout-after-quit] + '(menu-item "Restore Layout After Quit" gdb-toggle-restore-window-configuration + :button (:toggle . gdb-restore-window-configuration-after-quit) + :help "Toggle between always restore the window configuration (layout) after GDB quits and never restore.\n You can also change this setting in Customize to conditionally restore.")) (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) @@ -4502,9 +4641,6 @@ SPLIT-HORIZONTAL and show BUF in the new window." '(menu-item "Display Other Windows" gdb-many-windows :help "Toggle display of locals, stack and breakpoint information" :button (:toggle . gdb-many-windows))) - (define-key menu [gdb-restore-windows] - '(menu-item "Restore Window Layout" gdb-restore-windows - :help "Restore standard layout for debug session.")) (define-key menu [sep1] '(menu-item "--")) (define-key menu [all-threads] @@ -4579,41 +4715,173 @@ window is dedicated." (set-window-buffer window (get-buffer name)) (set-window-dedicated-p window t)) +(defun gdb-toggle-restore-window-configuration () + "Toggle whether to restore window configuration when GDB quits." + (interactive) + (setq gdb-restore-window-configuration-after-quit + (not gdb-restore-window-configuration-after-quit))) + +(defun gdb-get-source-buffer () + "Return a buffer displaying source file or nil if we can't find one. +The source file is the file that contains the source location +where GDB stops. There could be multiple source files during a +debugging session, we get the most recently showed one. If +program hasn't started running yet, the source file is the \"main +file\" where the GDB session starts (see `gdb-main-file')." + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (when gdb-main-file + (gud-find-file gdb-main-file)))) + (defun gdb-setup-windows () - "Layout the window pattern for option `gdb-many-windows'." - (gdb-get-buffer-create 'gdb-locals-buffer) - (gdb-get-buffer-create 'gdb-stack-buffer) - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (set-window-dedicated-p (selected-window) nil) - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (let ((win0 (selected-window)) - (win1 (split-window nil ( / ( * (window-height) 3) 4))) - (win2 (split-window nil ( / (window-height) 3))) - (win3 (split-window-right))) - (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3) - (select-window win2) - (set-window-buffer - win2 - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (if gdb-main-file - (gud-find-file gdb-main-file) - ;; Put buffer list in window if we - ;; can't find a source file. - (list-buffers-noselect)))) - (setq gdb-source-window (selected-window)) - (let ((win4 (split-window-right))) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-inferior-io) nil win4)) - (select-window win1) - (gdb-set-window-buffer (gdb-stack-buffer-name)) - (let ((win5 (split-window-right))) - (gdb-set-window-buffer (if gdb-show-threads-by-default - (gdb-threads-buffer-name) - (gdb-breakpoints-buffer-name)) - nil win5)) - (select-window win0))) + "Lay out the window pattern for option `gdb-many-windows'." + (if gdb-default-window-configuration-file + (gdb-load-window-configuration + (if (file-name-absolute-p gdb-default-window-configuration-file) + gdb-default-window-configuration-file + (expand-file-name gdb-default-window-configuration-file + gdb-window-configuration-directory))) + ;; Create default layout as before. + (gdb-get-buffer-create 'gdb-locals-buffer) + (gdb-get-buffer-create 'gdb-stack-buffer) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (let ((win0 (selected-window)) + (win1 (split-window nil ( / ( * (window-height) 3) 4))) + (win2 (split-window nil ( / (window-height) 3))) + (win3 (split-window-right))) + (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3) + (select-window win2) + (set-window-buffer win2 (or (gdb-get-source-buffer) + (list-buffers-noselect))) + (setq gdb-source-window-list (list (selected-window))) + (let ((win4 (split-window-right))) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-inferior-io) nil win4)) + (select-window win1) + (gdb-set-window-buffer (gdb-stack-buffer-name)) + (let ((win5 (split-window-right))) + (gdb-set-window-buffer (if gdb-show-threads-by-default + (gdb-threads-buffer-name) + (gdb-breakpoints-buffer-name)) + nil win5)) + (select-window win0)))) + +(defun gdb-buffer-p (buffer) + "Return t if BUFFER is GDB-related." + (with-current-buffer buffer + (eq gud-minor-mode 'gdbmi))) + +(defun gdb-function-buffer-p (buffer) + "Return t if BUFFER is a GDB function buffer. + +Function buffers are locals buffer, registers buffer, etc, but +not including main command buffer (the one where you type GDB +commands) or source buffers (that display program source code)." + (with-current-buffer buffer + (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode))) + +(defun gdb--buffer-type (buffer) + "Return the type of BUFFER if it is a function buffer. +Buffer type is like `gdb-registers-type', `gdb-stack-buffer'. +These symbols are used by `gdb-get-buffer-create'. + +Return nil if BUFFER is not a GDB function buffer." + (with-current-buffer buffer + (cl-loop for rule in gdb-buffer-rules + for mode-name = (gdb-rules-buffer-mode rule) + for type = (car rule) + if (eq mode-name major-mode) + return type + finally return nil))) + +(defun gdb-save-window-configuration (file) + "Save current window configuration (layout) to FILE. +You can later restore this configuration from that file by +`gdb-load-window-configuration'." + (interactive (list (read-file-name + "Save window configuration to file: " + (or gdb-window-configuration-directory + default-directory)))) + ;; We replace the buffer in each window with a placeholder, store + ;; the buffer type (register, breakpoint, etc) in window parameters, + ;; and write the window configuration to the file. + (save-window-excursion + (let ((placeholder (get-buffer-create " *gdb-placeholder*")) + (window-persistent-parameters + (cons '(gdb-buffer-type . writable) window-persistent-parameters))) + (unwind-protect + (dolist (win (window-list nil 'no-minibuffer)) + (select-window win) + (when (gdb-buffer-p (current-buffer)) + (set-window-parameter + nil 'gdb-buffer-type + (cond ((gdb-function-buffer-p (current-buffer)) + ;; 1) If a user arranged the window + ;; configuration herself and saves it, windows + ;; are probably not dedicated. 2) We use the + ;; same dedication flag as in + ;; `gdb-display-buffer'. + (set-window-dedicated-p nil t) + ;; We save this gdb-buffer-type symbol so + ;; we can later pass it to `gdb-get-buffer-create'; + ;; one example: `gdb-registers-buffer'. + (or (gdb--buffer-type (current-buffer)) + (error "Unrecognized gdb buffer mode: %s" major-mode))) + ;; Command buffer. + ((derived-mode-p 'gud-mode) 'command) + ;; Consider everything else as source buffer. + (t 'source))) + (with-window-non-dedicated nil + (set-window-buffer nil placeholder) + (set-window-prev-buffers (selected-window) nil) + (set-window-next-buffers (selected-window) nil)))) + ;; Save the window configuration to FILE. + (let ((window-config (window-state-get nil t))) + (with-temp-buffer + (prin1 window-config (current-buffer)) + (write-file file t))) + (kill-buffer placeholder))))) + +(defun gdb-load-window-configuration (file) + "Restore window configuration (layout) from FILE. +FILE should be a window configuration file saved by +`gdb-save-window-configuration'." + (interactive (list (read-file-name + "Restore window configuration from file: " + (or gdb-window-configuration-directory + default-directory)))) + ;; Basically, we restore window configuration and go through each + ;; window and restore the function buffers. + (let* ((placeholder (get-buffer-create " *gdb-placeholder*"))) + (unwind-protect ; Don't leak buffer. + (let ((window-config (with-temp-buffer + (insert-file-contents file) + ;; We need to go to point-min because + ;; `read' reads from point + (goto-char (point-min)) + (read (current-buffer)))) + (source-buffer (or (gdb-get-source-buffer) + ;; Do the same thing as in + ;; `gdb-setup-windows' if no source + ;; buffer is found. + (list-buffers-noselect))) + buffer-type) + (window-state-put window-config (frame-root-window)) + (dolist (window (window-list nil 'no-minibuffer)) + (with-selected-window window + (setq buffer-type (window-parameter nil 'gdb-buffer-type)) + (pcase buffer-type + ('source (when source-buffer + (set-window-buffer nil source-buffer) + (push (selected-window) gdb-source-window-list))) + ('command (switch-to-buffer gud-comint-buffer)) + (_ (let ((buffer (gdb-get-buffer-create buffer-type))) + (with-window-non-dedicated nil + (set-window-buffer nil buffer)))))))) + (kill-buffer placeholder)))) (define-minor-mode gdb-many-windows "If nil just pop up the GUD buffer unless `gdb-show-main' is t. @@ -4631,7 +4899,12 @@ of the debugged program. Non-nil means display the layout shown for (defun gdb-restore-windows () "Restore the basic arrangement of windows used by gdb. -This arrangement depends on the value of option `gdb-many-windows'." +This arrangement depends on the values of variable +`gdb-many-windows' and `gdb-default-window-configuration-file'." + ;; This function is used when the user messed up window + ;; configuration and wants to "reset to default". The function that + ;; sets up window configuration on start up is + ;; `gdb-get-source-file'. (interactive) (switch-to-buffer gud-comint-buffer) ;Select the right window and frame. (delete-other-windows) @@ -4644,7 +4917,7 @@ This arrangement depends on the value of option `gdb-many-windows'." (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) (gud-find-file gdb-main-file))) - (setq gdb-source-window win))))) + (setq gdb-source-window-list (list win)))))) ;; Called from `gud-sentinel' in gud.el: (defun gdb-reset () @@ -4678,11 +4951,25 @@ Kills the gdb buffers, and resets variables and the source buffers." (if (boundp 'speedbar-frame) (speedbar-timer-fn)) (setq gud-running nil) (setq gdb-active-process nil) - (remove-hook 'after-save-hook 'gdb-create-define-alist t)) + (remove-hook 'after-save-hook 'gdb-create-define-alist t) + ;; Recover window configuration. + (when (or (eq gdb-restore-window-configuration-after-quit t) + (and (eq gdb-restore-window-configuration-after-quit + 'if-gdb-show-main) + gdb-show-main) + (and (eq gdb-restore-window-configuration-after-quit + 'if-gdb-many-windows) + gdb-many-windows)) + (when gdb--window-configuration-before + (window-state-put gdb--window-configuration-before) + ;; This way we don't accidentally restore an outdated window + ;; configuration. + (setq gdb--window-configuration-before nil)))) (defun gdb-get-source-file () "Find the source file where the program starts and display it with related buffers, if required." + ;; This function is called only once on startup. (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) (setq gdb-main-file (read (match-string 1)))) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index cad74f9f63a..ab65a1590c0 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -1,4 +1,4 @@ -;;; glasses.el --- make cantReadThis readable +;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing separators, set `glasses-separator' to an empty string. If you don't want to replace existent separators, set `glasses-original-separator' to an empty string." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\", underscore separators are displayed as hyphens. If `glasses-original-separator' is an empty string, no such display change is performed." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default @@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter. For example, you can set `glasses-separator' to an empty string and `glasses-face' to `bold'. Then unreadable identifiers will have no separators, but will have their capitals in bold." - :group 'glasses :type '(choice (const :tag "None" nil) face) :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -100,7 +97,6 @@ but will have their capitals in bold." (defcustom glasses-separate-parentheses-p t "If non-nil, ensure space between an identifier and an opening parenthesis." - :group 'glasses :type 'boolean) (defcustom glasses-separate-parentheses-exceptions @@ -108,7 +104,6 @@ but will have their capitals in bold." "List of regexp that are exceptions for `glasses-separate-parentheses-p'. They are matched to the current line truncated to the point where the parenthesis expression starts." - :group 'glasses :type '(repeat regexp)) (defcustom glasses-separate-capital-groups t @@ -116,7 +111,6 @@ parenthesis expression starts." When the value is non-nil, HTMLSomething and IPv6 are displayed as HTML_Something and I_Pv6 respectively. Set the value to nil if you prefer to display them unchanged." - :group 'glasses :type 'boolean :version "24.1") @@ -124,7 +118,6 @@ if you prefer to display them unchanged." "If non-nil, downcase embedded capital letters in identifiers. Only identifiers starting with lower case letters are affected, letters inside other identifiers are unchanged." - :group 'glasses :type 'boolean :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -135,7 +128,6 @@ other identifiers are unchanged." Only words starting with this regexp are uncapitalized. The regexp is case sensitive. It has any effect only when `glasses-uncapitalize-p' is non-nil." - :group 'glasses :type 'regexp :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -149,7 +141,6 @@ file write then. Note the removal action does not try to be much clever, so it can remove real separators too." - :group 'glasses :type 'boolean) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d4aca28bd7c..c71a90344ff 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -64,8 +64,7 @@ SYMBOL should be one of `grep-command', `grep-template', "Number of lines in a grep window. If nil, use `compilation-window-height'." :type '(choice (const :tag "Default" nil) integer) - :version "22.1" - :group 'grep) + :version "22.1") (defcustom grep-highlight-matches 'auto-detect "Use special markers to highlight grep matches. @@ -98,9 +97,8 @@ To change the default value, use \\[customize] or call the function (const :tag "Use --color=always" always) (const :tag "Use --color" auto) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-scroll-output nil "Non-nil to scroll the *grep* buffer window as output appears. @@ -109,8 +107,7 @@ Setting it causes the grep commands to put point at the end of their output window so that the end of the output is always visible rather than the beginning." :type 'boolean - :version "22.1" - :group 'grep) + :version "22.1") ;;;###autoload (defcustom grep-command nil @@ -124,8 +121,7 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-template nil "The default command to run for \\[lgrep]. @@ -141,9 +137,8 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-use-null-device 'auto-detect "If t, append the value of `null-device' to `grep' commands. @@ -157,8 +152,7 @@ by `grep-compute-defaults'; to change the default value, use :type '(choice (const :tag "Do Not Append Null Device" nil) (const :tag "Append Null Device" t) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-use-null-filename-separator 'auto-detect "If non-nil, use `grep's `--null' option. @@ -167,19 +161,23 @@ This is done to disambiguate file names in `grep's output." :type '(choice (const :tag "Do Not Use `--null'" nil) (const :tag "Use `--null'" t) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) ;;;###autoload (defcustom grep-find-command nil "The default find command for \\[grep-find]. In interactive usage, the actual value of this variable is set up by `grep-compute-defaults'; to change the default value, use -\\[customize] or call the function `grep-apply-setting'." +\\[customize] or call the function `grep-apply-setting'. + +This variable can either be a string, or a cons of the +form (COMMAND . POSITION). In the latter case, COMMAND will be +used as the default command, and point will be placed at POSITION +for easier editing." :type '(choice string + (cons string integer) (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-find-template nil "The default command to run for \\[rgrep]. @@ -194,9 +192,8 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-files-aliases '(("all" . "* .[!.]* ..?*") ;; Don't match `..'. See bug#22577 @@ -213,8 +210,7 @@ by `grep-compute-defaults'; to change the default value, use ("texi" . "*.texi") ("asm" . "*.[sS]")) "Alist of aliases for the FILES argument to `lgrep' and `rgrep'." - :type 'alist - :group 'grep) + :type 'alist) (defcustom grep-find-ignored-directories vc-directory-exclusion-list "List of names of sub-directories which `rgrep' shall not recurse into. @@ -223,8 +219,7 @@ to determine whether cdr should not be recursed into. The default value is inherited from `vc-directory-exclusion-list'." :type '(choice (repeat :tag "Ignored directories" string) - (const :tag "No ignored directories" nil)) - :group 'grep) + (const :tag "No ignored directories" nil))) (defcustom grep-find-ignored-files (cons ".#*" (delq nil (mapcar (lambda (s) @@ -235,8 +230,7 @@ The default value is inherited from `vc-directory-exclusion-list'." If an element is a cons cell, the car is called on the search directory to determine whether cdr should not be excluded." :type '(choice (repeat :tag "Ignored file" string) - (const :tag "No ignored files" nil)) - :group 'grep) + (const :tag "No ignored files" nil))) (defcustom grep-save-buffers 'ask "If non-nil, save buffers before running the grep commands. @@ -251,22 +245,19 @@ to limit saving to files located under `my-grep-root'." (const :tag "Ask before saving" ask) (const :tag "Don't save buffers" nil) function - (other :tag "Save all buffers" t)) - :group 'grep) + (other :tag "Save all buffers" t))) (defcustom grep-error-screen-columns nil "If non-nil, column numbers in grep hits are screen columns. See `compilation-error-screen-columns'." :type '(choice (const :tag "Default" nil) integer) - :version "22.1" - :group 'grep) + :version "22.1") ;;;###autoload (defcustom grep-setup-hook nil "List of hook functions run by `grep-process-setup' (see `run-hooks')." - :type 'hook - :group 'grep) + :type 'hook) (defvar grep-mode-map (let ((map (make-sparse-keymap))) @@ -333,7 +324,10 @@ See `compilation-error-screen-columns'." ;; When bootstrapping, tool-bar-map is not properly initialized yet, ;; so don't do anything. (when (keymapp (butlast tool-bar-map)) + ;; We have to `copy-keymap' rather than use keymap inheritance because + ;; we want to put the new items at the *end* of the tool-bar. (let ((map (butlast (copy-keymap tool-bar-map))) + ;; FIXME: Nowadays the last button is not "help" but "search"! (help (last tool-bar-map))) ;; Keep Help last in tool bar (tool-bar-local-item "left-arrow" 'previous-error-no-select 'previous-error-no-select map @@ -439,15 +433,13 @@ and reveals the entire command line. The visibility of the abbreviated part can also be toggled with `grep-find-toggle-abbreviation'." :type 'boolean - :version "27.1" - :group 'grep) + :version "27.1") (defcustom grep-search-path '(nil) "List of directories to search for files named in grep messages. Elements should be directory names, not file names of directories. The value nil as an element means the grep messages buffer `default-directory'." - :group 'grep :version "27.1" :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) @@ -528,9 +520,8 @@ This variable's value takes effect when `grep-compute-defaults' is called." (const :tag "find -print0 | sort -z | xargs -0'" gnu-sort) string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "27.1" - :group 'grep) + :set #'grep-apply-setting + :version "27.1") ;; History of grep commands. ;;;###autoload @@ -562,7 +553,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne")) (setq-local grep-num-matches-found 0) (set (make-local-variable 'compilation-exit-message-function) - 'grep-exit-message) + #'grep-exit-message) (run-hooks 'grep-setup-hook)) (defun grep-exit-message (status code msg) @@ -612,7 +603,7 @@ This function is called from `compilation-filter-hook'." (defun grep-probe (command args &optional func result) (let (process-file-side-effects) (equal (condition-case nil - (apply (or func 'process-file) command args) + (apply (or func #'process-file) command args) (error nil)) (or result 0)))) @@ -808,7 +799,7 @@ The value depends on `grep-command', `grep-template', (buffer-substring-no-properties (point) (mark))) (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default)) + #'find-tag-default)) "")) (defun grep-default-command () @@ -863,11 +854,11 @@ The value depends on `grep-command', `grep-template', (set (make-local-variable 'compilation-directory-matcher) (list regexp-unmatchable)) (set (make-local-variable 'compilation-process-setup-function) - 'grep-process-setup) + #'grep-process-setup) (set (make-local-variable 'compilation-disable-input) t) (set (make-local-variable 'compilation-error-screen-columns) grep-error-screen-columns) - (add-hook 'compilation-filter-hook 'grep-filter nil t)) + (add-hook 'compilation-filter-hook #'grep-filter nil t)) (defun grep--save-buffers () (when grep-save-buffers @@ -914,7 +905,7 @@ list is empty)." (compilation-start (if (and grep-use-null-device null-device) (concat command-args " " null-device) command-args) - 'grep-mode)) + #'grep-mode)) ;;;###autoload @@ -993,23 +984,31 @@ these include `opts', `dir', `files', `null-device', `excl' and "Read regexp arg for interactive grep using `read-regexp'." (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history)) +(defvar grep-read-files-function #'grep-read-files--default) + +(defun grep-read-files--default () + ;; Instead of a `grep-read-files-function' variable, we used to lookup + ;; mode-specific functions in the major mode's symbol properties, so preserve + ;; this behavior for backward compatibility. + (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1 + (if old-function + (funcall old-function) + (let ((file-name-at-point + (run-hook-with-args-until-success 'file-name-at-point-functions))) + (or (if (and (stringp file-name-at-point) + (not (file-directory-p file-name-at-point))) + file-name-at-point) + (buffer-file-name) + (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))))) + (defun grep-read-files (regexp) "Read a file-name pattern arg for interactive grep. -The pattern can include shell wildcards. As whitespace triggers +The pattern can include shell wildcards. As SPC can triggers completion when entering a pattern, including it requires quoting, e.g. `\\[quoted-insert]<space>'. REGEXP is used as a string in the prompt." - (let* ((grep-read-files-function (get major-mode 'grep-read-files)) - (file-name-at-point - (run-hook-with-args-until-success 'file-name-at-point-functions)) - (bn (if grep-read-files-function - (funcall grep-read-files-function) - (or (if (and (stringp file-name-at-point) - (not (file-directory-p file-name-at-point))) - file-name-at-point) - (buffer-file-name) - (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))) + (let* ((bn (funcall grep-read-files-function)) (fn (and bn (stringp bn) (file-name-nondirectory bn))) @@ -1022,7 +1021,7 @@ REGEXP is used as a string in the prompt." (setq alias (car aliases) aliases (cdr aliases)) (if (string-match (mapconcat - 'wildcard-to-regexp + #'wildcard-to-regexp (split-string (cdr alias) nil t) "\\|") fn) @@ -1043,11 +1042,11 @@ REGEXP is used as a string in the prompt." "\" in files matching wildcard" (if default (concat " (default " default ")")) ": ") - 'read-file-name-internal + #'read-file-name-internal nil nil nil 'grep-files-history (delete-dups (delq nil (append (list default default-alias default-extension) - (mapcar 'car grep-files-aliases))))))) + (mapcar #'car grep-files-aliases))))))) (and files (or (cdr (assoc files grep-files-aliases)) files)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 540bc9ce7f3..092d15983e5 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -486,9 +486,8 @@ The value t means that there is no stack, and we are in display-file mode.") "Additional menu items to add to the speedbar frame.") ;; Make sure our special speedbar mode is loaded -(if (featurep 'speedbar) - (gud-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (gud-install-speedbar-variables)) (defun gud-expansion-speedbar-buttons (_directory _zero) "Wrapper for call to `speedbar-add-expansion-list'. @@ -2827,9 +2826,13 @@ Obeying it means displaying in another window the specified file and line." (buffer (with-current-buffer gud-comint-buffer (gud-find-file true-file))) - (window (and buffer - (or (get-buffer-window buffer) - (display-buffer buffer '(nil (inhibit-same-window . t)))))) + (window + (when buffer + (if (eq gud-minor-mode 'gdbmi) + (gdb-display-source-buffer buffer) + ;; Gud still has the old behavior. + (or (get-buffer-window buffer) + (display-buffer buffer '(nil (inhibit-same-window . t))))))) (pos)) (when buffer (with-current-buffer buffer @@ -2859,9 +2862,7 @@ Obeying it means displaying in another window the specified file and line." (widen) (goto-char pos)))) (when window - (set-window-point window gud-overlay-arrow-position) - (if (eq gud-minor-mode 'gdbmi) - (setq gdb-source-window window)))))) + (set-window-point window gud-overlay-arrow-position))))) ;; The gud-call function must do the right thing whether its invoking ;; keystroke is from the GUD buffer itself (via major-mode binding) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 10416ead603..0b1ba80edcb 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -162,7 +162,7 @@ This behavior is generally undesirable. If this option is non-nil, the outermos "\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'" "C/C++ header file name patterns to determine if current buffer is a header. Effective only if `hide-ifdef-expand-reinclusion-protection' is t." - :type 'string + :type 'regexp :version "25.1") (defvar hide-ifdef-mode-submap diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 69385d7060f..ec4fd58886a 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -182,14 +182,14 @@ definition is displayed instead." which specifies the `name' section. Can be used for localization support." :group 'idlwave-online-help - :type 'string) + :type 'regexp) (defcustom idlwave-help-doclib-keyword "KEYWORD" "A regexp for the heading word to search for in doclib headers which specifies the `keywords' section. Can be used for localization support." :group 'idlwave-online-help - :type 'string) + :type 'regexp) (defface idlwave-help-link '((t :inherit link)) @@ -267,7 +267,6 @@ support." (declare-function idlwave-find-class-definition "idlwave") (declare-function idlwave-find-inherited-class "idlwave") (declare-function idlwave-find-struct-tag "idlwave") -(declare-function idlwave-get-buffer-visiting "idlwave") (declare-function idlwave-in-quote "idlwave") (declare-function idlwave-make-full-name "idlwave") (declare-function idlwave-members-only "idlwave") @@ -880,7 +879,7 @@ This function can be used as `idlwave-extra-help-function'." (setq in-buf ; structure-tag completion is always in current buffer (if struct-tag idlwave-current-tags-buffer - (idlwave-get-buffer-visiting file))) + (find-buffer-visiting file))) ;; see if file is in a visited buffer, insert those contents (if in-buf (progn diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index dba70cb2821..99ac0877c8b 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1598,7 +1598,7 @@ number.") "A regular expression to match any IDL error.") (defvar idlwave-shell-halting-error - "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n" + "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+.*\\)\n" "A regular expression to match errors which halt execution.") (defvar idlwave-shell-cant-continue-error @@ -2640,7 +2640,7 @@ Assumes that `idlwave-shell-sources-alist' contains an entry for that module." (if (or (not source-file) (not (file-regular-p source-file)) (not (setq buf - (or (idlwave-get-buffer-visiting source-file) + (or (find-buffer-visiting source-file) (find-file-noselect source-file))))) (progn (message "The source file for module %s is probably not compiled" @@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;; event. mouse-drag-track does so. (if drag-track 'mouse-drag-track 'mouse-drag-region))) (funcall tracker event) - (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil) + (idlwave-shell-print (if (region-active-p) '(4) nil) ,help ,ev)))) ;; Begin terrible hack section -- XEmacs tests for button2 explicitly @@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (cond ((equal arg '(16)) (setq expr (read-string "Expression: "))) - ((and (or arg (idlwave-region-active-p)) + ((and (or arg (region-active-p)) (< (- (region-end) (region-beginning)) 2000)) (setq beg (region-beginning) end (region-end))) @@ -3241,8 +3241,7 @@ Does not work for a region with multiline blocks - use "Delete the temporary files and kill associated buffers." (if (stringp idlwave-shell-temp-pro-file) (condition-case nil - (let ((buf (idlwave-get-buffer-visiting - idlwave-shell-temp-pro-file))) + (let ((buf (find-buffer-visiting idlwave-shell-temp-pro-file))) (if (buffer-live-p buf) (kill-buffer buf)) (delete-file idlwave-shell-temp-pro-file)) @@ -3788,7 +3787,7 @@ handled by this command." (save-buffer) (setq idlwave-shell-last-save-and-action-file (buffer-file-name))) (idlwave-shell-last-save-and-action-file - (if (setq buf (idlwave-get-buffer-visiting + (if (setq buf (find-buffer-visiting idlwave-shell-last-save-and-action-file)) (with-current-buffer buf (save-buffer)))) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 2601c2e1653..90e56943f20 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -154,21 +154,6 @@ (eval-when-compile (require 'cl-lib)) (require 'idlw-help) -;; For XEmacs -(unless (fboundp 'line-beginning-position) - (defalias 'line-beginning-position 'point-at-bol)) -(unless (fboundp 'line-end-position) - (defalias 'line-end-position 'point-at-eol)) -(unless (fboundp 'char-valid-p) - (defalias 'char-valid-p 'characterp)) -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - -(if (not (fboundp 'cancel-timer)) - (condition-case nil - (require 'timer) - (error nil))) - (declare-function idlwave-shell-get-path-info "idlw-shell") (declare-function idlwave-shell-temp-file "idlw-shell") (declare-function idlwave-shell-is-running "idlw-shell") @@ -314,7 +299,7 @@ split then a terminal beep and warning are issued." expression will not be changed. Note that the indentation of a comment at the beginning of a line is never changed." :group 'idlwave-code-formatting - :type 'string) + :type 'regexp) (defcustom idlwave-begin-line-comment nil "A comment anchored at the beginning of line. @@ -596,12 +581,7 @@ like this: MyMethod <Class1,Class2,Class3> The value of this variable may be nil to inhibit display, or an integer to -indicate the maximum number of classes to display. - -On XEmacs, a full list of classes will also be placed into a `help-echo' -property on the completion items, so that the list of classes for the current -item is displayed in the echo area. If the value of this variable is a -negative integer, the `help-echo' property will be suppressed." +indicate the maximum number of classes to display." :group 'idlwave-completion :type '(choice (const :tag "Don't show" nil) (integer :tag "Number of classes shown" 1))) @@ -1069,7 +1049,6 @@ goto Goto Statements common-blocks Common Blocks keyword-parameters Keyword Parameters in routine definitions and calls system-variables System Variables -fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) class-arrows Object Arrows with class property" :group 'idlwave-misc :type '(set @@ -1084,7 +1063,6 @@ class-arrows Object Arrows with class property" (const :tag "Common Blocks" common-blocks) (const :tag "Keyword Parameters" keyword-parameters) (const :tag "System Variables" system-variables) - (const :tag "FIXME: Warning" fixme) (const :tag "Object Arrows with class property " class-arrows))) (defcustom idlwave-mode-hook nil @@ -1096,6 +1074,8 @@ class-arrows Object Arrows with class property" "Normal hook. Executed when idlwave.el is loaded." :group 'idlwave-misc :type 'hook) +(make-obsolete-variable 'idlwave-load-hook + "use `with-eval-after-load' instead." "28.1") (defvar idlwave-experimental nil "Non-nil means turn on a few experimental features. @@ -1151,23 +1131,16 @@ As a user, you should not set this to t.") ;; Common blocks (common-blocks '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" - (1 font-lock-keyword-face) ; "common" - (2 font-lock-constant-face nil t) ; block name + (1 font-lock-keyword-face) ; "common" + (2 font-lock-constant-face nil t) ; block name ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma - (goto-char (match-end 0)) ; needed for XEmacs, could be nil - nil - (1 font-lock-variable-name-face) ; variable names - ))) + nil nil (1 font-lock-variable-name-face)))) ; variable names ;; Batch files (batch-files '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) - ;; FIXME warning. - (fixme - '("\\<FIXME:" (0 font-lock-warning-face t))) - ;; Labels (label '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) @@ -1254,9 +1227,6 @@ As a user, you should not set this to t.") ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) beginning-of-line)) -(put 'idlwave-mode 'font-lock-defaults - idlwave-font-lock-defaults) ; XEmacs - (defconst idlwave-comment-line-start-skip "^[ \t]*;" "Regexp to match the start of a full-line comment. That is the _beginning_ of a line containing a comment delimiter `;' preceded @@ -1492,9 +1462,7 @@ Otherwise ARGS forms a list that is evaluated." (define-key map "\M-\C-i" 'idlwave-complete) (define-key map "\C-c\C-i" 'idlwave-update-routine-info) (define-key map "\C-c=" 'idlwave-resolve) - (define-key map - (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) - 'idlwave-mouse-context-help) + (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help) map) "Keymap used in IDL mode.") @@ -1870,7 +1838,6 @@ The main features of this mode are 8. Hooks ----- - Loading idlwave.el runs `idlwave-load-hook'. Turning on `idlwave-mode' runs `idlwave-mode-hook'. 9. Documentation and Customization @@ -1930,8 +1897,6 @@ The main features of this mode are (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) ;; Font-lock additions - ;; Following line is for Emacs - XEmacs uses the corresponding property - ;; on the `idlwave-mode' symbol. (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) (set (make-local-variable 'font-lock-mark-block-function) 'idlwave-mark-subprogram) @@ -2091,11 +2056,7 @@ Returns point if comment found and nil otherwise." (backward-char 1) (point))))) -(defun idlwave-region-active-p () - "Should we operate on an active region?" - (if (fboundp 'use-region-p) - (use-region-p) - (region-active-p))) +(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1") (defun idlwave-show-matching-quote () "Insert quote and show matching quote if this is end of a string." @@ -3832,15 +3793,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (setq start (match-end 0))) (setq ret_string (concat ret_string (substring string start last))))) -(defun idlwave-get-buffer-visiting (file) - ;; Return the buffer currently visiting FILE - (cond - ((boundp 'find-file-compare-truenames) ; XEmacs - (let ((find-file-compare-truenames t)) - (get-file-buffer file))) - ((fboundp 'find-buffer-visiting) ; Emacs - (find-buffer-visiting file)) - (t (error "This should not happen (idlwave-get-buffer-visiting)")))) +(define-obsolete-function-alias 'idlwave-get-buffer-visiting + #'find-buffer-visiting "28.1") (defvar idlwave-outlawed-buffers nil "List of buffers pulled up by IDLWAVE for special reasons. @@ -3848,7 +3802,7 @@ Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") (defun idlwave-find-file-noselect (file &optional why) ;; Return a buffer visiting file. - (or (idlwave-get-buffer-visiting file) + (or (find-buffer-visiting file) (let ((buf (find-file-noselect file))) (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) buf))) @@ -6636,7 +6590,6 @@ This function is not general, can only be used for completion stuff." "A form to evaluate after completion selection in *Completions* buffer.") (defconst idlwave-completion-mark (make-marker) "A mark pointing to the beginning of the completion string.") -(defvar completion-highlight-first-word-only) ;XEmacs. (defun idlwave-complete-in-buffer (type stype list selector prompt isa &optional prepare-display-function @@ -6715,12 +6668,7 @@ accumulate information on matching completions." list)) (let* ((list all-completions) ;; "complete" means, this is already a valid completion - (complete (memq spart all-completions)) - (completion-highlight-first-word-only t)) ; XEmacs - ;; (completion-fixup-function ; Emacs - ;; (lambda () (and (eq (preceding-char) ?>) - ;; (re-search-backward " <" beg t))))) - + (complete (memq spart all-completions))) (setq list (sort list (lambda (a b) (string< (downcase a) (downcase b))))) (if prepare-display-function @@ -6782,7 +6730,6 @@ accumulate information on matching completions." (let* ((do-prop (and (>= show-classes 0) (>= emacs-major-version 21))) (do-buf (not (= show-classes 0))) - ;; (do-dots (featurep 'xemacs)) (do-dots t) (inherit (if (and (not (eq type 'class-tag)) super-classes) (cons class-selector super-classes))) @@ -6848,10 +6795,6 @@ accumulate information on matching completions." ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- -(when (featurep 'xemacs) - (defvar rtn) - (defun idlwave-pset (item) - (set 'rtn item))) (defun idlwave-popup-select (ev list title &optional sort) "Select an item in LIST with a popup menu. @@ -6862,17 +6805,6 @@ sort the list before displaying." (cond ((null list)) ((= 1 (length list)) (setq rtn (car list))) - ((featurep 'xemacs) - (if sort (setq list (sort list (lambda (a b) - (string< (upcase a) (upcase b)))))) - (setq menu - (append (list title) - (mapcar (lambda (x) (vector x (list 'idlwave-pset - x))) - list))) - (setq menu (idlwave-split-menu-xemacs menu maxpopup)) - (let ((resp (get-popup-menu-response menu))) - (funcall (event-function resp) (event-object resp)))) (t (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) @@ -6880,36 +6812,14 @@ sort the list before displaying." (list (append (list "") (mapcar (lambda(x) (cons x x)) list))))) - (setq menu (idlwave-split-menu-emacs menu maxpopup)) + (setq menu (idlwave-split-menu menu maxpopup)) (setq rtn (x-popup-menu ev menu)))) rtn)) -(defun idlwave-split-menu-xemacs (menu N) - "Split the MENU into submenus of maximum length N." - (if (<= (length menu) (1+ N)) - ;; No splitting needed - menu - (let* ((title (car menu)) - (entries (cdr menu)) - (menu (list title)) - (cnt 0) - (nextmenu nil)) - (while entries - (while (and entries (< cnt N)) - (setq cnt (1+ cnt) - nextmenu (cons (car entries) nextmenu) - entries (cdr entries))) - (setq nextmenu (nreverse nextmenu)) - (setq nextmenu (cons (format "%s...%s" - (aref (car nextmenu) 0) - (aref (nth (1- cnt) nextmenu) 0)) - nextmenu)) - (setq menu (cons nextmenu menu) - nextmenu nil - cnt 0)) - (nreverse menu)))) +(define-obsolete-function-alias 'idlwave-split-menu-emacs + #'idlwave-split-menu "28.1") -(defun idlwave-split-menu-emacs (menu N) +(defun idlwave-split-menu (menu N) "Split the MENU into submenus of maximum length N." (if (<= (length (nth 1 menu)) (1+ N)) ;; No splitting needed @@ -6964,10 +6874,7 @@ sort the list before displaying." (move-marker idlwave-completion-mark beg) (setq idlwave-before-completion-wconf (current-window-configuration))) - (if (featurep 'xemacs) - (idlwave-display-completion-list-xemacs - list) - (idlwave-display-completion-list-emacs list)) + (idlwave-display-completion-list-1 list) ;; Store a special value in `this-command'. When `idlwave-complete' ;; finds this in `last-command', it will scroll the *Completions* buffer. @@ -7025,8 +6932,7 @@ The key which is associated with each option is generated automatically. First, the strings are checked for preselected keys, like in \"[P]rint\". If these don't exist, a letter in the string is automatically selected." (let* ((alist (symbol-value sym)) - (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) - '(fit-window-to-buffer))) + (temp-buffer-show-hook '(fit-window-to-buffer)) keys-alist char) ;; First check the cache (if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) @@ -7112,42 +7018,17 @@ If these don't exist, a letter in the string is automatically selected." (and (local-variable-p var (current-buffer)) (symbol-value var)))) -;; In XEmacs, we can use :activate-callback directly to advice the -;; choose functions. We use the private keymap only for the online -;; help feature. - (defvar idlwave-completion-map nil "Keymap for `completion-list-mode' with `idlwave-complete'.") -(defun idlwave-display-completion-list-xemacs (list &rest cl-args) - (with-output-to-temp-buffer "*Completions*" - (apply 'display-completion-list list - ':activate-callback 'idlwave-default-choose-completion - cl-args)) - (with-current-buffer "*Completions*" - (use-local-map - (or idlwave-completion-map - (setq idlwave-completion-map - (idlwave-make-modified-completion-map-xemacs - (current-local-map))))))) - (defun idlwave-default-choose-completion (&rest args) "Execute `default-choose-completion' and then restore the win-conf." (apply 'idlwave-choose 'default-choose-completion args)) -(defun idlwave-make-modified-completion-map-xemacs (old-map) - "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." - (let ((new-map (copy-keymap old-map))) - (define-key new-map [button3up] 'idlwave-mouse-completion-help) - (define-key new-map [button3] (lambda () - (interactive) - (setq this-command last-command))) - new-map)) - -;; In Emacs we also replace keybindings in the completion -;; map in order to install our wrappers. +(define-obsolete-function-alias 'idlwave-display-completion-list-emacs + #'idlwave-display-completion-list-1 "28.1") -(defun idlwave-display-completion-list-emacs (list) +(defun idlwave-display-completion-list-1 (list) "Display completion list and install the choose wrappers." (with-output-to-temp-buffer "*Completions*" (display-completion-list list)) @@ -7155,16 +7036,16 @@ If these don't exist, a letter in the string is automatically selected." (use-local-map (or idlwave-completion-map (setq idlwave-completion-map - (idlwave-make-modified-completion-map-emacs - (current-local-map))))))) + (idlwave-make-modified-completion-map (current-local-map))))))) + +(define-obsolete-function-alias 'idlwave-make-modified-completion-map-emacs + #'idlwave-make-modified-completion-map "28.1") -(defun idlwave-make-modified-completion-map-emacs (old-map) - "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." +(defun idlwave-make-modified-completion-map (old-map) + "Replace `choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) (substitute-key-definition 'choose-completion 'idlwave-choose-completion new-map) - (substitute-key-definition - 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) (define-key new-map [mouse-3] 'idlwave-mouse-completion-help) new-map)) @@ -7173,10 +7054,8 @@ If these don't exist, a letter in the string is automatically selected." (interactive (list last-nonmenu-event)) (apply 'idlwave-choose 'choose-completion args)) -(defun idlwave-mouse-choose-completion (&rest args) - "Click on an alternative in the `*Completions*' buffer to choose it." - (interactive "e") - (apply 'idlwave-choose 'mouse-choose-completion args)) +(define-obsolete-function-alias 'idlwave-mouse-choose-completion + #'idlwave-choose-completion "28.1") ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- @@ -7370,7 +7249,7 @@ class/struct definition." (file (idlwave-routine-source-file (nth 3 (idlwave-rinfo-assoc pro 'pro nil (idlwave-routines)))))) - (cons file (if file (idlwave-get-buffer-visiting file))))) + (cons file (if file (find-buffer-visiting file))))) (defun idlwave-scan-class-info (class) @@ -8241,15 +8120,9 @@ If we do not know about MODULE, just return KEYWORD literally." (defvar idlwave-rinfo-mouse-map (let ((map (make-sparse-keymap))) - (define-key map - (if (featurep 'xemacs) [button2] [mouse-2]) - 'idlwave-mouse-active-rinfo) - (define-key map - (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) - 'idlwave-mouse-active-rinfo-shift) - (define-key map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'idlwave-mouse-active-rinfo-right) + (define-key map [mouse-2] 'idlwave-mouse-active-rinfo) + (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift) + (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right) (define-key map " " 'idlwave-active-rinfo-space) (define-key map "q" 'idlwave-quit-help) map)) @@ -8301,7 +8174,6 @@ If we do not know about MODULE, just return KEYWORD literally." "Button2: Display info about same method in superclass") (col 0) (data (list name type class (current-buffer) nil initial-class)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (face 'idlwave-help-link) beg props win cnt total) ;; Fix keywords, but don't add chained super-classes, since these @@ -8326,7 +8198,7 @@ If we do not know about MODULE, just return KEYWORD literally." idlwave-current-obj_new-class) (when superclasses (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-class 'data (cons 'class data))) (let ((classes (cons initial-class superclasses)) c) @@ -8342,7 +8214,7 @@ If we do not know about MODULE, just return KEYWORD literally." (add-text-properties beg (point) props)))) (insert "\n"))) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-use 'data (cons 'usage data))) (if html-file (setq props (append (list 'face face 'link html-file) @@ -8370,7 +8242,7 @@ If we do not know about MODULE, just return KEYWORD literally." (setq beg (point) ;; Relevant keywords already have link property attached props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'data (cons 'keyword data) 'help-echo help-echo-kwd 'keyword (car x))) @@ -8384,7 +8256,7 @@ If we do not know about MODULE, just return KEYWORD literally." ;; Here entry is (key file (list of type-conses)) (while (setq entry (pop all)) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-src 'source (list (car (car (nth 2 entry))) ;type (nth 1 entry) @@ -8489,8 +8361,7 @@ to it." (add-text-properties beg (point) (list 'face 'bold))) (when (and file (not (equal file ""))) (setq beg (point)) - (insert (apply 'abbreviate-file-name - (if (featurep 'xemacs) (list file t) (list file)))) + (insert (apply 'abbreviate-file-name (list file))) (if file-props (add-text-properties beg (point) file-props))))) @@ -8650,10 +8521,9 @@ can be used to detect possible name clashes during this process." idlwave-user-catalog-routines idlwave-buffer-routines nil)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (keymap (make-sparse-keymap)) (props (list 'mouse-face 'highlight - km-prop keymap + 'local-map keymap 'help-echo "Mouse2: Find source")) (nroutines (length (or special-routines routines))) (step (/ nroutines 100)) @@ -8676,7 +8546,7 @@ can be used to detect possible name clashes during this process." (nth 2 b) (car b))))))) (message "Sorting routines...done") - (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) + (define-key keymap [(mouse-2)] (lambda (ev) (interactive "e") (mouse-set-point ev) @@ -9038,23 +8908,6 @@ Assumes that point is at the beginning of the unit as found by 'imenu) (error nil))))) -;; Here we hack func-menu.el in order to support this new mode. -;; The latest versions of func-menu.el already have this stuff in, so -;; we hack only if it is not already there. -(when (featurep 'xemacs) - (eval-after-load "func-menu" - '(progn - (or (assq 'idlwave-mode fume-function-name-regexp-alist) - (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems - (setq fume-function-name-regexp-alist - (cons '(idlwave-mode . fume-function-name-regexp-idl) - fume-function-name-regexp-alist))) - (or (assq 'idlwave-mode fume-find-function-name-method-alist) - (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems - (setq fume-find-function-name-method-alist - (cons '(idlwave-mode . fume-find-next-idl-function-name) - fume-find-function-name-method-alist)))))) - (defun idlwave-edit-in-idlde () "Edit the current file in IDL Development environment." (interactive) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index a24b94073fc..59db646ff32 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -130,9 +130,8 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword ;;; "This function binds many inferior-lisp commands to C-c <letter> bindings, ;;;where they are more accessible. C-c <letter> bindings are reserved for the -;;;user, so these bindings are non-standard. If you want them, you should -;;;have this function called by the inferior-lisp-load-hook: -;;; (add-hook 'inferior-lisp-load-hook 'inferior-lisp-install-letter-bindings) +;;;user, so these bindings are non-standard. If you want them: +;;; (with-eval-after-load 'inf-lisp 'inferior-lisp-install-letter-bindings) ;;;You can modify this function to install just the bindings you want." (defun inferior-lisp-install-letter-bindings () (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go) @@ -555,10 +554,7 @@ Used by these commands to determine defaults." ;;; Reads a string from the user. (defun lisp-symprompt (prompt default) - (list (let* ((prompt (if default - (format "%s (default %s): " prompt default) - (concat prompt ": "))) - (ans (read-string prompt))) + (list (let ((ans (read-string (format-prompt prompt default)))) (if (zerop (length ans)) default ans)))) @@ -632,6 +628,8 @@ See variable `lisp-describe-sym-command'." ;;;=============================== (defvar inferior-lisp-load-hook nil "This hook is run when the library `inf-lisp' is loaded.") +(make-obsolete-variable 'inferior-lisp-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'inferior-lisp-load-hook) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5ec3e942753..5c50e2accdf 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4570,7 +4570,7 @@ This function is intended for use in `after-change-functions'." ;; Comments (setq-local comment-start "// ") - (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) @@ -4591,7 +4591,8 @@ This function is intended for use in `after-change-functions'." (setq imenu-create-index-function #'js--imenu-create-index) ;; for filling, pretend we're cc-mode - (c-init-language-vars js-mode) + (c-foreign-init-lit-pos-cache) + (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t) (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local comment-multi-line t) (setq-local electric-indent-chars diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index ec246d63ac2..235279e226e 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -316,7 +316,7 @@ not be enclosed in { } or ( )." (defconst makefile-gmake-statements `("-sinclude" "sinclude" ; makefile-makepp-statements takes rest "ifdef" "ifndef" "ifeq" "ifneq" "-include" "define" "endef" "export" - "override define" "override" "unexport" "vpath" + "override define" "override" "unexport" "vpath" "undefine" ,@(cdr makefile-automake-statements)) "List of keywords understood by gmake.") diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 6f0e535def8..4a5d872b790 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -895,6 +895,8 @@ The environment marked is the one that contains point or follows point." "Hook evaluated when first loading Metafont or MetaPost mode." :type 'hook :group 'meta-font) +(make-obsolete-variable 'meta-mode-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom meta-common-mode-hook nil "Hook evaluated by both `metafont-mode' and `metapost-mode'." diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 9e039562549..55a78c6cc85 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -165,7 +165,7 @@ parenthetical grouping.") (modify-syntax-entry ?| "." table) (modify-syntax-entry ?! "." table) (modify-syntax-entry ?\\ "." table) - (modify-syntax-entry ?\' "." table) + (modify-syntax-entry ?\' "\"" table) (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) @@ -619,8 +619,7 @@ Key bindings: (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) (setq-local beginning-of-defun-function 'octave-beginning-of-defun) (and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment)) - (add-function :before-until (local 'eldoc-documentation-function) - 'octave-eldoc-function) + (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t) (easy-menu-add octave-mode-menu)) @@ -756,7 +755,7 @@ Key bindings: (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil)) (setq-local info-lookup-mode 'octave-mode) - (setq-local eldoc-documentation-function 'octave-eldoc-function) + (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t) (setq-local comint-input-ring-file-name (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist")) @@ -1049,10 +1048,9 @@ directory and makes this the current buffer's default directory." (save-excursion (skip-syntax-backward "-(") (thing-at-point 'symbol))))) - (completing-read - (format (if def "Function (default %s): " "Function: ") def) - (inferior-octave-completion-table) - nil nil nil nil def))) + (completing-read (format-prompt "Function" def) + (inferior-octave-completion-table) + nil nil nil nil def))) (defun octave-goto-function-definition (fn) "Go to the function definition of FN in current buffer." @@ -1173,10 +1171,7 @@ q: Don't fix\n" func file)) (min (line-end-position 4) end) t) (match-string 1)))) - (old-func (read-string (format (if old-func - "Name to replace (default %s): " - "Name to replace: ") - old-func) + (old-func (read-string (format-prompt "Name to replace" old-func) nil nil old-func))) (if (and func old-func (not (equal func old-func))) (perform-replace old-func func 'query @@ -1455,7 +1450,7 @@ The block marked is the one that contains point or follows point." Prompt for the function's name, arguments and return values (to be entered without parens)." (let* ((defname (file-name-sans-extension (buffer-name))) - (name (read-string (format "Function name (default %s): " defname) + (name (read-string (format-prompt "Function name" defname) nil nil defname)) (args (read-string "Arguments: ")) (vals (read-string "Return values: "))) @@ -1640,8 +1635,8 @@ code line." (nreverse result))))) (cdr octave-eldoc-cache)) -(defun octave-eldoc-function () - "A function for `eldoc-documentation-function' (which see)." +(defun octave-eldoc-function (&rest _ignored) + "A function for `eldoc-documentation-functions' (which see)." (when (inferior-octave-process-live-p) (let* ((ppss (syntax-ppss)) (paren-pos (cadr ppss)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index fcd9294f660..8c060991f42 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1688,7 +1688,7 @@ comment block. If not in a // comment, just does a normal newline." ;; as comment starters. Fix it here by removing the "2" from the syntax ;; of the second char of such sequences. ("/\\(\\*\\)" (1 ". 3b")) - ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) ;; Pascal uses '' and "" rather than \' and \" to escape quotes. ("''\\|\"\"" (0 (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 13505d04a2d..fce059bafc7 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -187,7 +187,7 @@ ;; as comment starters. Fix it here by removing the "2" from the syntax ;; of the second char of such sequences. ("/\\(\\*\\)" (1 ". 3b")) - ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) ;; Pascal uses '' and "" rather than \' and \" to escape quotes. ("''\\|\"\"" (0 (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) @@ -589,7 +589,7 @@ See also `pascal-comment-area'." (interactive) (catch 'found (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re))) - (forward-sexp 1)) + (ignore-errors (forward-sexp 1))) (let ((nest 0) (max -1) (func 0) (reg (concat pascal-beg-block-re "\\|" pascal-end-block-re "\\|" @@ -1170,26 +1170,27 @@ indent of the current line in parameterlist." (defun pascal-type-completion (pascal-str) "Calculate all possible completions for types." - (let ((start (point)) - (pascal-all ()) - goon) - ;; Search for all reachable type declarations - (while (or (pascal-beg-of-defun) - (setq goon (not goon))) - (save-excursion - (if (and (< start (prog1 (save-excursion (pascal-end-of-defun) - (point)) - (forward-char 1))) - (re-search-forward - "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>" - start t) - (not (match-end 1))) - ;; Check current type declaration - (setq pascal-all - (nconc (pascal-get-completion-decl pascal-str) - pascal-all))))) + (save-excursion + (let ((start (point)) + (pascal-all ()) + goon) + ;; Search for all reachable type declarations + (while (or (pascal-beg-of-defun) + (setq goon (not goon))) + (save-excursion + (if (and (< start (prog1 (save-excursion (pascal-end-of-defun) + (point)) + (forward-char 1))) + (re-search-forward + "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>" + start t) + (not (match-end 1))) + ;; Check current type declaration + (setq pascal-all + (nconc (pascal-get-completion-decl pascal-str) + pascal-all))))) - pascal-all)) + pascal-all))) (defun pascal-var-completion (prefix) "Calculate all possible completions for variables (or constants)." @@ -1263,11 +1264,13 @@ indent of the current line in parameterlist." (and (eq state 'defun) (save-excursion (re-search-backward ")[ \t]*:" (point-at-bol) t)))) - (if (or (eq state 'paramlist) (eq state 'defun)) - (pascal-beg-of-defun)) - (nconc - (pascal-type-completion pascal-str) - (pascal-keyword-completion pascal-type-keywords pascal-str))) + (save-excursion + (if (or (eq state 'paramlist) (eq state 'defun)) + (pascal-beg-of-defun)) + (nconc + (pascal-type-completion pascal-str) + (pascal-keyword-completion pascal-type-keywords + pascal-str)))) ( ;--Starting a new statement (and (not (eq state 'contexp)) (save-excursion @@ -1392,7 +1395,7 @@ The default is a name found in the buffer around point." (defvar pascal-outline-map (let ((map (make-sparse-keymap))) (if (fboundp 'set-keymap-name) - (set-keymap-name pascal-outline-map 'pascal-outline-map)) + (set-keymap-name map 'pascal-outline-map)) (define-key map "\M-\C-a" 'pascal-outline-prev-defun) (define-key map "\M-\C-e" 'pascal-outline-next-defun) (define-key map "\C-c\C-d" 'pascal-outline-goto-defun) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f864f6a34cd..127b24cb890 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -214,7 +214,9 @@ (defconst perl--syntax-exp-intro-regexp (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" (regexp-opt perl--syntax-exp-intro-keywords) - "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) + "\\|[?:.,;|&*=!~({[]" + "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't! + "\\|\\(^\\)\\)[ \t\n]*"))) (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) @@ -235,7 +237,7 @@ (match-beginning 0)))))) (string-to-syntax ". p")))) ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) + ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f5f4092babf..7180ba317c3 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,6 +1,11 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Version: 0.5.2 +;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) + +;; This is a GNU ELPA :core package. Avoid using functionality that +;; not compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. @@ -19,6 +24,11 @@ ;;; Commentary: +;; NOTE: The project API is still experimental and can change in major, +;; backward-incompatible ways. Everyone is encouraged to try it, and +;; report to us any problems or use cases we hadn't anticipated, by +;; sending an email to emacs-devel, or `M-x report-emacs-bug'. +;; ;; This file contains generic infrastructure for dealing with ;; projects, some utility functions, and commands using that ;; infrastructure. @@ -27,16 +37,29 @@ ;; current project, without having to know which package handles ;; detection of that project type, parsing its config files, etc. ;; -;; NOTE: The project API is still experimental and can change in major, -;; backward-incompatible ways. Everyone is encouraged to try it, and -;; report to us any problems or use cases we hadn't anticipated, by -;; sending an email to emacs-devel, or `M-x report-emacs-bug'. +;; This file consists of following parts: +;; +;; Infrastructure (the public API): +;; +;; Function `project-current' that returns the current project +;; instance based on the value of the hook `project-find-functions', +;; and several generic functions that act on it. +;; +;; `project-root' must be defined for every project. +;; `project-files' can be overridden for performance purposes. +;; `project-ignores' and `project-external-roots' describe the project +;; files and its relations to external directories. `project-files' +;; should be consistent with `project-ignores'. ;; -;; Infrastructure: +;; This list can change in future versions. ;; -;; Function `project-current', to determine the current project -;; instance, and 5 (at the moment) generic functions that act on it. -;; This list is to be extended in future versions. +;; VC project: +;; +;; Originally conceived as an example implementation, now it's a +;; relatively fast backend that delegates to 'git ls-files' or 'hg +;; status' to list the project's files. It honors the VC ignore +;; files, but supports additions to the list using the user option +;; `project-vc-ignores' (usually through .dir-locals.el). ;; ;; Utils: ;; @@ -45,9 +68,49 @@ ;; ;; Commands: ;; -;; `project-find-file', `project-find-regexp' and -;; `project-or-external-find-regexp' use the current API, and thus -;; will work in any project that has an adapter. +;; `project-prefix-map' contains the full list of commands defined in +;; this package. This map uses the prefix `C-x p' by default. +;; Type `C-x p f' to find file in the current project. +;; Type `C-x p C-h' to see all available commands and bindings. +;; +;; All commands defined in this package are implemented using the +;; public API only. As a result, they will work with any project +;; backend that follows the protocol. +;; +;; Any third-party code that wants to use this package should likewise +;; target the public API. Use any of the built-in commands as the +;; example. +;; +;; How to create a new backend: +;; +;; - Consider whether you really should, or whether there are other +;; ways to reach your goals. If the backend's performance is +;; significantly lower than that of the built-in one, and it's first +;; in the list, it will affect all commands that use it. Unless you +;; are going to be using it only yourself or in special circumstances, +;; you will probably want it to be fast, and it's unlikely to be a +;; trivial endeavor. `project-files' is the method to optimize (the +;; default implementation gets slower the more files the directory +;; has, and the longer the list of ignores is). +;; +;; - Choose the format of the value that represents a project for your +;; backend (we call it project instance). Don't use any of the +;; formats from other backends. The format can be arbitrary, as long +;; as the datatype is something `cl-defmethod' can dispatch on. The +;; value should be stable (when compared with `equal') across +;; invocations, meaning calls to that function from buffers belonging +;; to the same project should return equal values. +;; +;; - Write a new function that will determine the current project +;; based on the directory and add it to `project-find-functions' +;; (which see) using `add-hook'. It is a good idea to depend on the +;; directory only, and not on the current major mode, for example. +;; Because the usual expectation is that all files in the directory +;; belong to the same project (even if some/most of them are ignored). +;; +;; - Define new methods for some or all generic functions for this +;; backend using `cl-defmethod'. A `project-root' method is +;; mandatory, `project-files' is recommended, the rest are optional. ;;; TODO: @@ -72,9 +135,7 @@ ;; whole Emacs session, independent of the current directory. Or, ;; in the more advanced case, open a set of projects, and have some ;; project-related commands to use them all. E.g., have a command -;; to search for a regexp across all open projects. Provide a -;; history of projects that were opened in the past (storing it as a -;; list of directories should suffice). +;; to search for a regexp across all open projects. ;; ;; * Support for project-local variables: a UI to edit them, and a ;; utility function to retrieve a value. Probably useless without @@ -88,43 +149,81 @@ ;;; Code: (require 'cl-generic) +(require 'seq) +(eval-when-compile (require 'subr-x)) + +(defgroup project nil + "Operations on the current project." + :version "28.1" + :group 'tools) (defvar project-find-functions (list #'project-try-vc) "Special hook to find the project containing a given directory. Each functions on this hook is called in turn with one -argument (the directory) and should return either nil to mean -that it is not applicable, or a project instance.") +argument, the directory in which to look, and should return +either nil to mean that it is not applicable, or a project instance. +The exact form of the project instance is up to each respective +function; the only practical limitation is to use values that +`cl-defmethod' can dispatch on, like a cons cell, or a list, or a +CL struct.") + +(defvar project-current-inhibit-prompt nil + "Non-nil to skip prompting the user in `project-current'.") ;;;###autoload -(defun project-current (&optional maybe-prompt dir) - "Return the project instance in DIR or `default-directory'. -When no project found in DIR, and MAYBE-PROMPT is non-nil, ask -the user for a different directory to look in. If that directory -is not a part of a detectable project either, return a -`transient' project instance rooted in it." - (unless dir (setq dir default-directory)) - (let ((pr (project--find-in-directory dir))) +(defun project-current (&optional maybe-prompt directory) + "Return the project instance in DIRECTORY, defaulting to `default-directory'. + +When no project is found in that directory, the result depends on +the value of MAYBE-PROMPT: if it is nil or omitted, return nil, +else ask the user for a directory in which to look for the +project, and if no project is found there, return a \"transient\" +project instance. + +The \"transient\" project instance is a special kind of value +which denotes a project rooted in that directory and includes all +the files under the directory except for those that should be +ignored (per `project-ignores'). + +See the doc string of `project-find-functions' for the general form +of the project instance object." + (unless directory (setq directory default-directory)) + (let ((pr (project--find-in-directory directory))) (cond (pr) - (maybe-prompt - (setq dir (read-directory-name "Choose the project directory: " dir nil t) - pr (project--find-in-directory dir)) - (unless pr - (message "Using `%s' as a transient project root" dir) - (setq pr (cons 'transient dir))))) + ((unless project-current-inhibit-prompt + maybe-prompt) + (setq directory (project-prompt-project-dir) + pr (project--find-in-directory directory)))) + (when maybe-prompt + (if pr + (project-remember-project pr) + (project--remove-from-project-list directory) + (setq pr (cons 'transient directory)))) pr)) (defun project--find-in-directory (dir) (run-hook-with-args-until-success 'project-find-functions dir)) -(cl-defgeneric project-roots (project) - "Return the list of directory roots of the current project. +(cl-defgeneric project-root (project) + "Return root directory of the current project. + +It usually contains the main build file, dependencies +configuration file, etc. Though neither is mandatory. -Most often it's just one directory which contains the project -build file and everything else in the project. But in more -advanced configurations, a project can span multiple directories. +The directory name must be absolute." + (car (project-roots project))) -The directory names should be absolute.") +(cl-defgeneric project-roots (project) + "Return the list containing the current project root. + +The function is obsolete, all projects have one main root anyway, +and the rest should be possible to express through +`project-external-roots'." + ;; FIXME: Can we specify project's version here? + ;; FIXME: Could we make this affect cl-defmethod calls too? + (declare (obsolete project-root "0.3.0")) + (list (project-root project))) ;; FIXME: Add MODE argument, like in `ede-source-paths'? (cl-defgeneric project-external-roots (_project) @@ -133,18 +232,14 @@ The directory names should be absolute.") It's the list of directories outside of the project that are still related to it. If the project deals with source code then, depending on the languages used, this list should include the -headers search path, load path, class path, and so on. - -The rule of thumb for whether to include a directory here, and -not in `project-roots', is whether its contents are meant to be -edited together with the rest of the project." +headers search path, load path, class path, and so on." nil) (cl-defgeneric project-ignores (_project _dir) "Return the list of glob patterns to ignore inside DIR. Patterns can match both regular files and directories. To root an entry, start it with `./'. To match directories only, -end it with `/'. DIR must be one of `project-roots' or +end it with `/'. DIR must be either `project-root' or one of `project-external-roots'." ;; TODO: Document and support regexp ignores as used by Hg. ;; TODO: Support whitelist entries. @@ -165,21 +260,22 @@ end it with `/'. DIR must be one of `project-roots' or (t (complete-with-action action all-files string pred))))) -(cl-defmethod project-roots ((project (head transient))) - (list (cdr project))) +(cl-defmethod project-root ((project (head transient))) + (cdr project)) (cl-defgeneric project-files (project &optional dirs) "Return a list of files in directories DIRS in PROJECT. DIRS is a list of absolute directories; it should be some -subset of the project roots and external roots. +subset of the project root and external roots. The default implementation uses `find-program'. PROJECT is used to find the list of ignores for each directory." - (cl-mapcan + (mapcan (lambda (dir) (project--files-in-directory dir (project--dir-ignores project dir))) - (or dirs (project-roots project)))) + (or dirs + (list (project-root project))))) (defun project--files-in-directory (dir ignores &optional files) (require 'find-dired) @@ -218,14 +314,24 @@ to find the list of ignores for each directory." local-files)))) (defgroup project-vc nil - "Project implementation using the VC package." + "Project implementation based on the VC package." :version "25.1" - :group 'tools) + :group 'project) (defcustom project-vc-ignores nil "List of patterns to include in `project-ignores'." :type '(repeat string) - :safe 'listp) + :safe #'listp) + +(defcustom project-vc-merge-submodules t + "Non-nil to consider submodules part of the parent project. + +After changing this variable (using Customize or .dir-locals.el) +you might have to restart Emacs to see the effect." + :type 'boolean + :version "28.1" + :package-version '(project . "0.2.0") + :safe #'booleanp) ;; FIXME: Using the current approach, major modes are supposed to set ;; this variable to a buffer-local value. So we don't have access to @@ -263,20 +369,56 @@ The directory names should be absolute. Used in the VC project backend implementation of `project-external-roots'.") (defun project-try-vc (dir) - (let* ((backend (ignore-errors (vc-responsible-backend dir))) + (let* ((backend + ;; FIXME: This is slow. Cache it. + (ignore-errors (vc-responsible-backend dir))) (root (pcase backend ('Git ;; Don't stop at submodule boundary. + ;; FIXME: Cache for a shorter time. (or (vc-file-getprop dir 'project-git-root) - (vc-file-setprop dir 'project-git-root - (vc-find-root dir ".git/")))) + (let ((root (vc-call-backend backend 'root dir))) + (vc-file-setprop + dir 'project-git-root + (if (and + ;; FIXME: Invalidate the cache when the value + ;; of this variable changes. + (project--vc-merge-submodules-p root) + (project--submodule-p root)) + (let* ((parent (file-name-directory + (directory-file-name root)))) + (vc-call-backend backend 'root parent)) + root))))) ('nil nil) (_ (ignore-errors (vc-call-backend backend 'root dir)))))) (and root (cons 'vc root)))) -(cl-defmethod project-roots ((project (head vc))) - (list (cdr project))) +(defun project--submodule-p (root) + ;; XXX: We only support Git submodules for now. + ;; + ;; For submodules, at least, we expect the users to prefer them to + ;; be considered part of the parent project. For those who don't, + ;; there is the custom var now. + ;; + ;; Some users may also set up things equivalent to Git submodules + ;; using "git worktree" (for example). However, we expect that most + ;; of them would prefer to treat those as separate projects anyway. + (let* ((gitfile (expand-file-name ".git" root))) + (cond + ((file-directory-p gitfile) + nil) + ((with-temp-buffer + (insert-file-contents gitfile) + (goto-char (point-min)) + ;; Kind of a hack to distinguish a submodule from + ;; other cases of .git files pointing elsewhere. + (looking-at "gitdir: [./]+/\\.git/modules/")) + t) + (t nil)))) + +(cl-defmethod project-root ((project (head vc))) + (cdr project)) (cl-defmethod project-external-roots ((project (head vc))) (project-subtract-directories @@ -284,10 +426,10 @@ backend implementation of `project-external-roots'.") (mapcar #'file-name-as-directory (funcall project-vc-external-roots-function))) - (project-roots project))) + (list (project-root project)))) (cl-defmethod project-files ((project (head vc)) &optional dirs) - (cl-mapcan + (mapcan (lambda (dir) (let (backend) (if (and (file-equal-p dir (cdr project)) @@ -302,7 +444,8 @@ backend implementation of `project-external-roots'.") (project--files-in-directory dir (project--dir-ignores project dir))))) - (or dirs (project-roots project)))) + (or dirs + (list (project-root project))))) (declare-function vc-git--program-version "vc-git") (declare-function vc-git--run-command-string "vc-git") @@ -331,20 +474,23 @@ backend implementation of `project-external-roots'.") (split-string (apply #'vc-git--run-command-string nil "ls-files" args) "\0" t))) - ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. - (let* ((submodules (project--git-submodules)) - (sub-files - (mapcar - (lambda (module) - (when (file-directory-p module) - (project--vc-list-files - (concat default-directory module) - backend - extra-ignores))) - submodules))) - (setq files - (apply #'nconc files sub-files))) - files)) + (when (project--vc-merge-submodules-p default-directory) + ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. + (let* ((submodules (project--git-submodules)) + (sub-files + (mapcar + (lambda (module) + (when (file-directory-p module) + (project--vc-list-files + (concat default-directory module) + backend + extra-ignores))) + submodules))) + (setq files + (apply #'nconc files sub-files)))) + ;; 'git ls-files' returns duplicate entries for merge conflicts. + ;; XXX: Better solutions welcome, but this seems cheap enough. + (delete-consecutive-dups files))) (`Hg (let ((default-directory (expand-file-name (file-name-as-directory dir))) args) @@ -362,6 +508,11 @@ backend implementation of `project-external-roots'.") (lambda (s) (concat default-directory s)) (split-string (buffer-string) "\0" t))))))) +(defun project--vc-merge-submodules-p (dir) + (project--value-in-dir + 'project-vc-merge-submodules + dir)) + (defun project--git-submodules () ;; 'git submodule foreach' is much slower. (condition-case nil @@ -376,7 +527,7 @@ backend implementation of `project-external-roots'.") (cl-defmethod project-ignores ((project (head vc)) dir) (let* ((root (cdr project)) - backend) + backend) (append (when (file-equal-p dir root) (setq backend (vc-responsible-backend root)) @@ -424,6 +575,102 @@ DIRS must contain directory names." (hack-dir-local-variables-non-file-buffer)) (symbol-value var))) + +;;; Project commands + +;;;###autoload +(defvar project-prefix-map + (let ((map (make-sparse-keymap))) + (define-key map "!" 'project-shell-command) + (define-key map "&" 'project-async-shell-command) + (define-key map "f" 'project-find-file) + (define-key map "F" 'project-or-external-find-file) + (define-key map "b" 'project-switch-to-buffer) + (define-key map "s" 'project-shell) + (define-key map "d" 'project-dired) + (define-key map "v" 'project-vc-dir) + (define-key map "c" 'project-compile) + (define-key map "e" 'project-eshell) + (define-key map "k" 'project-kill-buffers) + (define-key map "p" 'project-switch-project) + (define-key map "g" 'project-find-regexp) + (define-key map "G" 'project-or-external-find-regexp) + (define-key map "r" 'project-query-replace-regexp) + map) + "Keymap for project commands.") + +;;;###autoload (define-key ctl-x-map "p" project-prefix-map) + +;; We can't have these place-specific maps inherit from +;; project-prefix-map because project--other-place-command needs to +;; know which map the key binding came from, as if it came from one of +;; these maps, we don't want to set display-buffer-overriding-action + +(defvar project-other-window-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-o" #'project-display-buffer) + map) + "Keymap for project commands that display buffers in other windows.") + +(defvar project-other-frame-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-o" #'project-display-buffer-other-frame) + map) + "Keymap for project commands that display buffers in other frames.") + +(defun project--other-place-command (action &optional map) + (let* ((key (read-key-sequence-vector nil t)) + (place-cmd (lookup-key map key)) + (generic-cmd (lookup-key project-prefix-map key)) + (switch-to-buffer-obey-display-actions t) + (display-buffer-overriding-action (unless place-cmd action))) + (if-let ((cmd (or place-cmd generic-cmd))) + (call-interactively cmd) + (user-error "%s is undefined" (key-description key))))) + +;;;###autoload +(defun project-other-window-command () + "Run project command, displaying resultant buffer in another window. + +The following commands are available: + +\\{project-prefix-map} +\\{project-other-window-map}" + (interactive) + (project--other-place-command '((display-buffer-pop-up-window) + (inhibit-same-window . t)) + project-other-window-map)) + +;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command) + +;;;###autoload +(defun project-other-frame-command () + "Run project command, displaying resultant buffer in another frame. + +The following commands are available: + +\\{project-prefix-map} +\\{project-other-frame-map}" + (interactive) + (project--other-place-command '((display-buffer-pop-up-frame)) + project-other-frame-map)) + +;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command) + +;;;###autoload +(defun project-other-tab-command () + "Run project command, displaying resultant buffer in a new tab. + +The following commands are available: + +\\{project-prefix-map}" + (interactive) + (project--other-place-command '((display-buffer-in-new-tab)))) + +;;;###autoload +(when (bound-and-true-p tab-prefix-map) + (define-key tab-prefix-map "p" #'project-other-tab-command)) + (declare-function grep-read-files "grep") (declare-function xref--show-xrefs "xref") (declare-function xref--find-ignores-arguments "xref") @@ -443,7 +690,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (let* ((pr (project-current t)) (files (if (not current-prefix-arg) - (project-files pr (project-roots pr)) + (project-files pr) (let ((dir (read-directory-name "Base directory: " nil default-directory t))) (project--files-in-directory dir @@ -454,9 +701,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." nil))) (defun project--dir-ignores (project dir) - (let* ((roots (project-roots project)) - (root (cl-find dir roots :test #'file-in-directory-p))) - (if (not root) + (let ((root (project-root project))) + (if (not (file-in-directory-p dir root)) (project-ignores nil nil) ;The defaults. (let ((ignores (project-ignores project root))) (if (file-equal-p root dir) @@ -474,8 +720,8 @@ pattern to search for." (require 'xref) (let* ((pr (project-current t)) (files - (project-files pr (append - (project-roots pr) + (project-files pr (cons + (project-root pr) (project-external-roots pr))))) (xref--show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) @@ -489,47 +735,29 @@ pattern to search for." (user-error "No matches for: %s" regexp)) xrefs)) -(defun project--process-file-region (start end program - &optional buffer display - &rest args) - ;; FIXME: This branching shouldn't be necessary, but - ;; call-process-region *is* measurably faster, even for a program - ;; doing some actual work (for a period of time). Even though - ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). - (if (not (file-remote-p default-directory)) - (apply #'call-process-region - start end program nil buffer display args) - (let ((infile (make-temp-file "ppfr"))) - (unwind-protect - (progn - (write-region start end infile nil 'silent) - (apply #'process-file program infile buffer display args)) - (delete-file infile))))) - (defun project--read-regexp () (let ((sym (thing-at-point 'symbol))) (read-regexp "Find regexp" (and sym (regexp-quote sym))))) ;;;###autoload (defun project-find-file () - "Visit a file (with completion) in the current project's roots. + "Visit a file (with completion) in the current project. The completion default is the filename at point, if one is recognized." (interactive) (let* ((pr (project-current t)) - (dirs (project-roots pr))) + (dirs (list (project-root pr)))) (project-find-file-in (thing-at-point 'filename) dirs pr))) ;;;###autoload (defun project-or-external-find-file () - "Visit a file (with completion) in the current project's roots or external roots. + "Visit a file (with completion) in the current project or external roots. The completion default is the filename at point, if one is recognized." (interactive) (let* ((pr (project-current t)) - (dirs (append - (project-roots pr) + (dirs (cons + (project-root pr) (project-external-roots pr)))) (project-find-file-in (thing-at-point 'filename) dirs pr))) @@ -541,6 +769,7 @@ For the arguments list, see `project--read-file-cpd-relative'." (const :tag "Read with completion from absolute names" project--read-file-absolute) (function :tag "Custom function" nil)) + :group 'project :version "27.1") (defun project--read-file-cpd-relative (prompt @@ -577,9 +806,10 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in (defun project-find-file-in (filename dirs project) "Complete FILENAME in DIRS in PROJECT and visit the result." (let* ((all-files (project-files project dirs)) + (completion-ignore-case read-file-name-completion-ignore-case) (file (funcall project-read-file-name-function - "Find file" all-files nil nil - filename))) + "Find file" all-files nil nil + filename))) (if (string= file "") (user-error "You didn't specify the file") (find-file file)))) @@ -605,6 +835,71 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in collection predicate t res hist nil))) res)) +;;;###autoload +(defun project-dired () + "Start Dired in the current project's root." + (interactive) + (dired (project-root (project-current t)))) + +;;;###autoload +(defun project-vc-dir () + "Run VC-Dir in the current project's root." + (interactive) + (vc-dir (project-root (project-current t)))) + +;;;###autoload +(defun project-shell () + "Start an inferior shell in the current project's root directory. +If a buffer already exists for running a shell in the project's root, +switch to it. Otherwise, create a new shell buffer. +With \\[universal-argument] prefix arg, create a new inferior shell buffer even +if one already exists." + (interactive) + (let* ((default-directory (project-root (project-current t))) + (default-project-shell-name + (concat "*" (file-name-nondirectory + (directory-file-name + (file-name-directory default-directory))) + "-shell*")) + (shell-buffer (get-buffer default-project-shell-name))) + (if (and shell-buffer (not current-prefix-arg)) + (pop-to-buffer shell-buffer) + (shell (generate-new-buffer-name default-project-shell-name))))) + +;;;###autoload +(defun project-eshell () + "Start Eshell in the current project's root directory. +If a buffer already exists for running Eshell in the project's root, +switch to it. Otherwise, create a new Eshell buffer. +With \\[universal-argument] prefix arg, create a new Eshell buffer even +if one already exists." + (interactive) + (defvar eshell-buffer-name) + (let* ((default-directory (project-root (project-current t))) + (eshell-buffer-name + (concat "*" (file-name-nondirectory + (directory-file-name + (file-name-directory default-directory))) + "-eshell*")) + (eshell-buffer (get-buffer eshell-buffer-name))) + (if (and eshell-buffer (not current-prefix-arg)) + (pop-to-buffer eshell-buffer) + (eshell t)))) + +;;;###autoload +(defun project-async-shell-command () + "Run `async-shell-command' in the current project's root directory." + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'async-shell-command))) + +;;;###autoload +(defun project-shell-command () + "Run `shell-command' in the current project's root directory." + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'shell-command))) + (declare-function fileloop-continue "fileloop" ()) ;;;###autoload @@ -632,5 +927,327 @@ loop using the command \\[fileloop-continue]." from to (project-files (project-current t)) 'default) (fileloop-continue)) +(defvar compilation-read-command) +(declare-function compilation-read-command "compile") + +;;;###autoload +(defun project-compile (command &optional comint) + "Run `compile' in the project root. +Arguments the same as in `compile'." + (interactive + (list + (let ((command (eval compile-command))) + (if (or compilation-read-command current-prefix-arg) + (compilation-read-command command) + command)) + (consp current-prefix-arg))) + (let* ((pr (project-current t)) + (default-directory (project-root pr))) + (compile command comint))) + +(defun project--read-project-buffer () + (let* ((pr (project-current t)) + (current-buffer (current-buffer)) + (other-buffer (other-buffer current-buffer)) + (other-name (buffer-name other-buffer)) + (predicate + (lambda (buffer) + ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist. + (and (cdr buffer) + (equal pr + (with-current-buffer (cdr buffer) + (project-current))))))) + (read-buffer + "Switch to buffer: " + (when (funcall predicate (cons other-name other-buffer)) + other-name) + nil + predicate))) + +;;;###autoload +(defun project-switch-to-buffer (buffer-or-name) + "Display buffer BUFFER-OR-NAME in the selected window. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical." + (interactive (list (project--read-project-buffer))) + (switch-to-buffer buffer-or-name)) + +;;;###autoload +(defun project-display-buffer (buffer-or-name) + "Display BUFFER-OR-NAME in some window, without selecting it. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical. + +This function uses `display-buffer' as a subroutine, which see +for how it is determined where the buffer will be displayed." + (interactive (list (project--read-project-buffer))) + (display-buffer buffer-or-name)) + +;;;###autoload +(defun project-display-buffer-other-frame (buffer-or-name) + "Display BUFFER-OR-NAME preferably in another frame. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical. + +This function uses `display-buffer-other-frame' as a subroutine, +which see for how it is determined where the buffer will be +displayed." + (interactive (list (project--read-project-buffer))) + (display-buffer-other-frame buffer-or-name)) + +(defcustom project-kill-buffer-conditions + '(buffer-file-name ; All file-visiting buffers are included. + ;; Most of the temp buffers in the background: + (major-mode . fundamental-mode) + ;; non-text buffer such as xref, occur, vc, log, ... + (and (derived-mode . special-mode) + (not (major-mode . help-mode))) + (derived-mode . compilation-mode) + (derived-mode . dired-mode) + (derived-mode . diff-mode)) + "List of conditions to kill buffers related to a project. +This list is used by `project-kill-buffers'. +Each condition is either: +- a regular expression, to match a buffer name, +- a predicate function that takes a buffer object as argument + and returns non-nil if the buffer should be killed, +- a cons-cell, where the car describes how to interpret the cdr. + The car can be one of the following: + * `major-mode': the buffer is killed if the buffer's major + mode is eq to the cons-cell's cdr + * `defived-mode': the buffer is killed if the buffer's major + mode is derived from the major mode denoted by the cons-cell's + cdr + * `not': the cdr is interpreted as a negation of a condition. + * `and': the cdr is a list of recursive conditions, that all have + to be met. + * `or': the cdr is a list of recursive conditions, of which at + least one has to be met. + +If any of these conditions are satified for a buffer in the +current project, it will be killed." + :type '(repeat (choice regexp function symbol + (cons :tag "Major mode" + (const major-mode) symbol) + (cons :tag "Derived mode" + (const derived-mode) symbol) + (cons :tag "Negation" + (const not) sexp) + (cons :tag "Conjunction" + (const and) sexp) + (cons :tag "Disjunction" + (const or) sexp))) + :version "28.1" + :group 'project + :package-version '(project . "0.6.0")) + +(defun project--buffer-list (pr) + "Return the list of all buffers in project PR." + (let (bufs) + (dolist (buf (buffer-list)) + (when (equal pr + (with-current-buffer buf + (project-current))) + (push buf bufs))) + (nreverse bufs))) + +(defun project--kill-buffer-check (buf conditions) + "Check if buffer BUF matches any element of the list CONDITIONS. +See `project-kill-buffer-conditions' for more details on the form +of CONDITIONS." + (catch 'kill + (dolist (c conditions) + (when (cond + ((stringp c) + (string-match-p c (buffer-name buf))) + ((symbolp c) + (funcall c buf)) + ((eq (car-safe c) 'major-mode) + (eq (buffer-local-value 'major-mode buf) + (cdr c))) + ((eq (car-safe c) 'derived-mode) + (provided-mode-derived-p + (buffer-local-value 'major-mode buf) + (cdr c))) + ((eq (car-safe c) 'not) + (not (project--kill-buffer-check buf (cdr c)))) + ((eq (car-safe c) 'or) + (project--kill-buffer-check buf (cdr c))) + ((eq (car-safe c) 'and) + (seq-every-p + (apply-partially #'project--kill-buffer-check + buf) + (mapcar #'list (cdr c))))) + (throw 'kill t))))) + +(defun project--buffers-to-kill (pr) + "Return list of buffers in project PR to kill. +What buffers should or should not be killed is described +in `project-kill-buffer-conditions'." + (let (bufs) + (dolist (buf (project--buffer-list pr)) + (when (project--kill-buffer-check buf project-kill-buffer-conditions) + (push buf bufs))) + bufs)) + +;;;###autoload +(defun project-kill-buffers (&optional no-confirm) + "Kill the buffers belonging to the current project. +Two buffers belong to the same project if their project +instances, as reported by `project-current' in each buffer, are +identical. Only the buffers that match a condition in +`project-kill-buffer-conditions' will be killed. If NO-CONFIRM +is non-nil, the command will not ask the user for confirmation. +NO-CONFIRM is always nil when the command is invoked +interactivly." + (interactive) + (let* ((pr (project-current t)) + (bufs (project--buffers-to-kill pr))) + (cond (no-confirm + (mapc #'kill-buffer bufs)) + ((null bufs) + (message "No buffers to kill")) + ((yes-or-no-p (format "Kill %d buffers in %s? " + (length bufs) + (project-root pr))) + (mapc #'kill-buffer bufs))))) + + +;;; Project list + +(defcustom project-list-file (locate-user-emacs-file "projects") + "File in which to save the list of known projects." + :type 'file + :version "28.1" + :group 'project) + +(defvar project--list 'unset + "List structure containing root directories of known projects. +With some possible metadata (to be decided).") + +(defun project--read-project-list () + "Initialize `project--list' using contents of `project-list-file'." + (let ((filename project-list-file)) + (setq project--list + (when (file-exists-p filename) + (with-temp-buffer + (insert-file-contents filename) + (read (current-buffer))))) + (unless (seq-every-p + (lambda (elt) (stringp (car-safe elt))) + project--list) + (warn "Contents of %s are in wrong format, resetting" + project-list-file) + (setq project--list nil)))) + +(defun project--ensure-read-project-list () + "Initialize `project--list' if it isn't already initialized." + (when (eq project--list 'unset) + (project--read-project-list))) + +(defun project--write-project-list () + "Save `project--list' in `project-list-file'." + (let ((filename project-list-file)) + (with-temp-buffer + (insert ";;; -*- lisp-data -*-\n") + (pp project--list (current-buffer)) + (write-region nil nil filename nil 'silent)))) + +;;;###autoload +(defun project-remember-project (pr) + "Add project PR to the front of the project list. +Save the result in `project-list-file' if the list of projects has changed." + (project--ensure-read-project-list) + (let ((dir (project-root pr))) + (unless (equal (caar project--list) dir) + (dolist (ent project--list) + (when (equal dir (car ent)) + (setq project--list (delq ent project--list)))) + (push (list dir) project--list) + (project--write-project-list)))) + +(defun project--remove-from-project-list (pr-dir) + "Remove directory PR-DIR of a missing project from the project list. +If the directory was in the list before the removal, save the +result in `project-list-file'. Announce the project's removal +from the list." + (project--ensure-read-project-list) + (when-let ((ent (assoc pr-dir project--list))) + (setq project--list (delq ent project--list)) + (message "Project `%s' not found; removed from list" pr-dir) + (project--write-project-list))) + +(defun project-prompt-project-dir () + "Prompt the user for a directory that is one of the known project roots. +The project is chosen among projects known from the project list, +see `project-list-file'. +It's also possible to enter an arbitrary directory not in the list." + (project--ensure-read-project-list) + (let* ((dir-choice "... (choose a dir)") + (choices + ;; XXX: Just using this for the category (for the substring + ;; completion style). + (project--file-completion-table + (append project--list `(,dir-choice)))) + (pr-dir (completing-read "Select project: " choices nil t))) + (if (equal pr-dir dir-choice) + (read-directory-name "Select directory: " default-directory nil t) + pr-dir))) + +;;;###autoload +(defun project-known-project-roots () + "Return the list of root directories of all known projects." + (project--ensure-read-project-list) + (mapcar #'car project--list)) + + +;;; Project switching + +;;;###autoload +(defvar project-switch-commands + '((?f "Find file" project-find-file) + (?g "Find regexp" project-find-regexp) + (?d "Dired" project-dired) + (?v "VC-Dir" project-vc-dir) + (?e "Eshell" project-eshell)) + "Alist mapping keys to project switching menu entries. +Used by `project-switch-project' to construct a dispatch menu of +commands available upon \"switching\" to another project. + +Each element is of the form (KEY LABEL COMMAND), where COMMAND is the +command to run when KEY is pressed. LABEL is used to distinguish +the menu entries in the dispatch menu.") + +(defun project--keymap-prompt () + "Return a prompt for the project swithing dispatch menu." + (mapconcat + (pcase-lambda (`(,key ,label)) + (format "[%s] %s" + (propertize (key-description `(,key)) 'face 'bold) + label)) + project-switch-commands + " ")) + +;;;###autoload +(defun project-switch-project () + "\"Switch\" to another project by running an Emacs command. +The available commands are presented as a dispatch menu +made from `project-switch-commands'." + (interactive) + (let ((dir (project-prompt-project-dir)) + (choice nil)) + (while (not choice) + (setq choice (assq (read-event (project--keymap-prompt)) + project-switch-commands))) + (let ((default-directory dir) + (project-current-inhibit-prompt t)) + (call-interactively (nth 2 choice))))) + (provide 'project) ;;; project.el ends here diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 99b57354e25..fa281ddf4eb 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -271,10 +271,6 @@ (require 'easymenu) (require 'align) -(eval-when-compile - (or (fboundp 'use-region-p) - (defsubst use-region-p () (region-exists-p)))) - (defgroup prolog nil "Editing and running Prolog and Mercury files." :group 'languages) @@ -2373,12 +2369,8 @@ In effect it sets the `fill-prefix' when inside comments and then calls ;; in prolog-help-function-i (t (let* ((word (prolog-atom-under-point)) - (predicate (read-string - (format "Help on predicate%s: " - (if word - (concat " (default " word ")") - "")) - nil nil word)) + (predicate (read-string (format-prompt "Help on predicate" word) + nil nil word)) ;;point ) (if prolog-help-function-i @@ -2752,20 +2744,6 @@ When called with prefix argument ARG, disable zipping instead." (nth 1 state))) )))) -;; For backward compatibility. Stolen from custom.el. -(or (fboundp 'match-string) - ;; Introduced in Emacs 19.29. - (defun match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING." - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num)))))) - (defun prolog-pred-start () "Return the starting point of the first clause of the current predicate." ;; FIXME: Use SMIE. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 785b941402a..ccbcb081305 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -261,7 +261,6 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) -(require 'json) (require 'tramp-sh) ;; Avoid compiler warnings @@ -284,24 +283,6 @@ :link '(emacs-commentary-link "python")) -;;; 24.x Compat - - -(eval-and-compile - (unless (fboundp 'prog-first-column) - (defun prog-first-column () - 0)) - (unless (fboundp 'file-local-name) - (defun file-local-name (file) - "Return the local name component of FILE. -It returns a file name which can be used directly as argument of -`process-file', `start-file-process', or `shell-command'." - (or (file-remote-p file 'localname) file)))) - -;; In Emacs 24.3 and earlier, `define-derived-mode' does not define -;; the hook variable, it only puts documentation on the symbol. -(defvar inferior-python-mode-hook) - ;;; Bindings @@ -634,6 +615,8 @@ builtins.") (,(lambda (limit) (let ((re (python-rx (group (+ (any word ?. ?_))) (? ?\[ (+ (not (any ?\]))) ?\]) (* space) + ;; A type, like " : int ". + (? ?: (* space) (+ (any word ?. ?_)) (* space)) assignment-operator)) (res nil)) (while (and (setq res (re-search-forward re limit t)) @@ -1993,7 +1976,7 @@ position, else returns nil." ;; IPython prompts activated, this adds some safeguard for that. "In : " "\\.\\.\\.: ") "List of regular expressions matching input prompts." - :type '(repeat string) + :type '(repeat regexp) :version "24.4") (defcustom python-shell-prompt-output-regexps @@ -2001,28 +1984,28 @@ position, else returns nil." "Out\\[[0-9]+\\]: " ; IPython "Out :") ; ipdb safeguard "List of regular expressions matching output prompts." - :type '(repeat string) + :type '(repeat regexp) :version "24.4") (defcustom python-shell-prompt-regexp ">>> " "Regular expression matching top level input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-block-regexp "\\.\\.\\.:? " "Regular expression matching block input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-output-regexp "" "Regular expression matching output prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ " "Regular expression matching pdb input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (define-obsolete-variable-alias 'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1") @@ -2091,7 +2074,7 @@ executed through tramp connections." This variable, when set to a string, makes the environment to be modified such that shells are started within the specified virtualenv." - :type '(choice (const nil) string) + :type '(choice (const nil) directory) :group 'python) (defcustom python-shell-setup-codes nil @@ -2111,7 +2094,7 @@ virtualenv." "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()") 1 2)) "`compilation-error-regexp-alist' for inferior Python." - :type '(alist string) + :type '(alist regexp) :group 'python) (defmacro python-shell--add-to-path-with-priority (pathvar paths) @@ -2276,6 +2259,18 @@ Do not set this variable directly, instead use Do not set this variable directly, instead use `python-shell-prompt-set-calculated-regexps'.") +(defalias 'python--parse-json-array + (if (fboundp 'json-parse-string) + (lambda (string) + (json-parse-string string :array-type 'list)) + (require 'json) + (defvar json-array-type) + (declare-function json-read-from-string "json" (string)) + (lambda (string) + (let ((json-array-type 'list)) + (json-read-from-string string)))) + "Parse the JSON array in STRING into a Lisp list.") + (defun python-shell-prompt-detect () "Detect prompts for the current `python-shell-interpreter'. When prompts can be retrieved successfully from the @@ -2324,11 +2319,11 @@ detection and just returns nil." (catch 'prompts (dolist (line (split-string output "\n" t)) (let ((res - ;; Check if current line is a valid JSON array - (and (string= (substring line 0 2) "[\"") + ;; Check if current line is a valid JSON array. + (and (string-prefix-p "[\"" line) (ignore-errors - ;; Return prompts as a list, not vector - (append (json-read-from-string line) nil))))) + ;; Return prompts as a list. + (python--parse-json-array line))))) ;; The list must contain 3 strings, where the first ;; is the input prompt, the second is the block ;; prompt and the last one is the output prompt. The @@ -2796,6 +2791,7 @@ variable. python-shell-comint-watch-for-first-prompt-output-filter python-comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)) + (setq-local comint-highlight-input nil) (set (make-local-variable 'compilation-error-regexp-alist) python-shell-compilation-regexp-alist) (add-hook 'completion-at-point-functions @@ -3785,7 +3781,7 @@ the top stack frame has been reached. Filename is expected in the first parenthesized expression. Line number is expected in the second parenthesized expression." - :type 'string + :type 'regexp :version "27.1" :safe 'stringp) @@ -4560,7 +4556,7 @@ returns will be used. If not FORCE-PROCESS is passed what :type 'boolean :version "25.1") -(defun python-eldoc-function () +(defun python-eldoc-function (&rest _ignored) "`eldoc-documentation-function' for Python. For this to work as best as possible you should call `python-shell-send-buffer' from time to time so context in @@ -4589,9 +4585,7 @@ Interactively, prompt for symbol." (interactive (let ((symbol (python-eldoc--get-symbol-at-point)) (enable-recursive-minibuffers t)) - (list (read-string (if symbol - (format "Describe symbol (default %s): " symbol) - "Describe symbol: ") + (list (read-string (format-prompt "Describe symbol" symbol) nil nil symbol)))) (message (python-eldoc--get-doc-at-point symbol))) @@ -5540,12 +5534,16 @@ REPORT-FN is Flymake's callback function." (current-column)))) (^ '(- (1+ (current-indentation)))))) - (if (null eldoc-documentation-function) - ;; Emacs<25 - (set (make-local-variable 'eldoc-documentation-function) - #'python-eldoc-function) - (add-function :before-until (local 'eldoc-documentation-function) - #'python-eldoc-function)) + (with-no-warnings + ;; supress warnings about eldoc-documentation-function being obsolete + (if (null eldoc-documentation-function) + ;; Emacs<25 + (set (make-local-variable 'eldoc-documentation-function) + #'python-eldoc-function) + (if (boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) + (add-function :before-until (local 'eldoc-documentation-function) + #'python-eldoc-function)))) (add-to-list 'hs-special-modes-alist diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5da5577c108..831acf87bf0 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -801,7 +801,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'." (let ((coding-system (ruby--detect-encoding))) (when coding-system (if (looking-at "^#!") (beginning-of-line 2)) - (cond ((looking-at "\\s *#\\s *.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") + (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") ;; update existing encoding comment if necessary (unless (string= (match-string 2) coding-system) (goto-char (match-beginning 2)) @@ -1060,22 +1060,12 @@ delimiter." (goto-char (point)) ) ((looking-at "[\\[{(]") - (let ((deep (ruby-deep-indent-paren-p (char-after)))) - (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg))) - (progn - (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]") - (setq pnt (1- (match-end 0)))) - (setq nest (cons (cons (char-after (point)) pnt) nest)) - (setq pcol (cons (cons pnt depth) pcol)) - (setq depth 0)) - (setq nest (cons (cons (char-after (point)) pnt) nest)) - (setq depth (1+ depth)))) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq depth (1+ depth)) (goto-char pnt) ) ((looking-at "[])}]") - (if (ruby-deep-indent-paren-p (matching-paren (char-after))) - (setq depth (cdr (car pcol)) pcol (cdr pcol)) - (setq depth (1- depth))) + (setq depth (1- depth)) (setq nest (cdr nest)) (goto-char pnt)) ((looking-at ruby-block-end-re) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 751d7da5427..33ba0d11d80 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -116,7 +116,7 @@ (defvar scheme-imenu-generic-expression '((nil - "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4) + "^(define\\(?:-\\(?:generic\\(?:-procedure\\)?\\|method\\)\\)?\\s-+(?\\(\\sw+\\)" 1) ("Types" "^(define-class\\s-+(?\\(\\sw+\\)" 1) ("Macros" diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index cc6d5b46ed2..3c249b7bc0e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -64,61 +64,10 @@ ;; * Indent right half sh-basic-offset ;; / Indent left half sh-basic-offset. ;; -;; There are 4 commands to help set the indentation variables: -;; -;; `sh-show-indent' -;; This shows what variable controls the indentation of the current -;; line and its value. -;; -;; `sh-set-indent' -;; This allows you to set the value of the variable controlling the -;; current line's indentation. You can enter a number or one of a -;; number of special symbols to denote the value of sh-basic-offset, -;; or its negative, or half it, or twice it, etc. If you've used -;; cc-mode this should be familiar. If you forget which symbols are -;; valid simply press C-h at the prompt. -;; -;; `sh-learn-line-indent' -;; Simply make the line look the way you want it, then invoke this -;; command. It will set the variable to the value that makes the line -;; indent like that. If called with a prefix argument then it will set -;; the value to one of the symbols if applicable. -;; -;; `sh-learn-buffer-indent' -;; This is the deluxe function! It "learns" the whole buffer (use -;; narrowing if you want it to process only part). It outputs to a -;; buffer *indent* any conflicts it finds, and all the variables it has -;; learned. This buffer is a sort of Occur mode buffer, allowing you to -;; easily find where something was set. It is popped to automatically -;; if there are any conflicts found or if `sh-popup-occur-buffer' is -;; non-nil. -;; `sh-indent-comment' will be set if all comments follow the same -;; pattern; if they don't it will be set to nil. -;; Whether `sh-basic-offset' is set is determined by variable -;; `sh-learn-basic-offset'. -;; -;; Unfortunately, `sh-learn-buffer-indent' can take a long time to run -;; (e.g. if there are large case statements). Perhaps it does not make -;; sense to run it on large buffers: if lots of lines have different -;; indentation styles it will produce a lot of diagnostics in the -;; *indent* buffer; if there is a consistent style then running -;; `sh-learn-buffer-indent' on a small region of the buffer should -;; suffice. -;; ;; Saving indentation values ;; ------------------------- -;; After you've learned the values in a buffer, how to you remember -;; them? Originally I had hoped that `sh-learn-buffer-indent' -;; would make this unnecessary; simply learn the values when you visit -;; the buffer. -;; You can do this automatically like this: -;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent) -;; -;; However... `sh-learn-buffer-indent' is extremely slow, -;; especially on large-ish buffer. Also, if there are conflicts the -;; "last one wins" which may not produce the desired setting. -;; -;; So...There is a minimal way of being able to save indentation values and +;; After you've learned the values in a buffer, how to you remember them? +;; There is a minimal way of being able to save indentation values and ;; to reload them in another buffer or at another point in time. ;; ;; Use `sh-name-style' to give a name to the indentation settings of @@ -132,7 +81,7 @@ ;; Indentation variables - buffer local or global? ;; ---------------------------------------------- ;; I think that often having them buffer-local makes sense, -;; especially if one is using `sh-learn-buffer-indent'. However, if +;; especially if one is using `smie-config-guess'. However, if ;; a user sets values using customization, these changes won't appear ;; to work if the variables are already local! ;; @@ -175,18 +124,10 @@ ;; - Indenting many lines is slow. It currently does each line ;; independently, rather than saving state information. ;; -;; - `sh-learn-buffer-indent' is extremely slow. -;; -;; - "case $x in y) echo ;; esac)" the last ) is mis-identified as being -;; part of a case-pattern. You need to add a semi-colon after "esac" to -;; coerce sh-script into doing the right thing. -;; ;; - "echo $z in ps | head)" the last ) is mis-identified as being part of ;; a case-pattern. You need to put the "in" between quotes to coerce ;; sh-script into doing the right thing. ;; -;; - A line starting with "}>foo" is not indented like "} >foo". -;; ;; Richard Sharman <rsharman@pobox.com> June 1999. ;;; Code: @@ -474,10 +415,10 @@ This is buffer-local in every such buffer.") (define-key map "\C-c\C-i" 'sh-if) (define-key map "\C-c\C-f" 'sh-for) (define-key map "\C-c\C-c" 'sh-case) - (define-key map "\C-c?" 'sh-show-indent) - (define-key map "\C-c=" 'sh-set-indent) - (define-key map "\C-c<" 'sh-learn-line-indent) - (define-key map "\C-c>" 'sh-learn-buffer-indent) + (define-key map "\C-c?" #'smie-config-show-indent) + (define-key map "\C-c=" #'smie-config-set-indent) + (define-key map "\C-c<" #'smie-config-set-indent) + (define-key map "\C-c>" #'smie-config-guess) (define-key map "\C-c\C-\\" 'sh-backslash-region) (define-key map "\C-c+" 'sh-add) @@ -493,17 +434,14 @@ This is buffer-local in every such buffer.") (define-key map [remap backward-sentence] 'sh-beginning-of-command) (define-key map [remap forward-sentence] 'sh-end-of-command) (define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map)) - (define-key menu-map [sh-learn-buffer-indent] - '(menu-item "Learn buffer indentation" sh-learn-buffer-indent + (define-key menu-map [smie-config-guess] + '(menu-item "Learn buffer indentation" smie-config-guess :help "Learn how to indent the buffer the way it currently is.")) - (define-key menu-map [sh-learn-line-indent] - '(menu-item "Learn line indentation" sh-learn-line-indent - :help "Learn how to indent a line as it currently is indented")) - (define-key menu-map [sh-show-indent] - '(menu-item "Show indentation" sh-show-indent + (define-key menu-map [smie-config-show-indent] + '(menu-item "Show indentation" smie-config-show-indent :help "Show the how the current line would be indented")) - (define-key menu-map [sh-set-indent] - '(menu-item "Set indentation" sh-set-indent + (define-key menu-map [smie-config-set-indent] + '(menu-item "Set indentation" smie-config-set-indent :help "Set the indentation for the current line")) (define-key menu-map [sh-pair] @@ -900,7 +838,7 @@ See `sh-feature'.") font-lock-variable-name-face)) (rc sh-append es) - (bash sh-append sh ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) )) + (bash sh-append sh ("\\$(\\([^)\n]+\\)" (1 'sh-quoted-exec t) )) (sh sh-append shell ;; Variable names. ("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2 @@ -1158,7 +1096,7 @@ subshells can nest." (")" (0 (sh-font-lock-paren (match-beginning 0)))) ;; Highlight (possibly nested) subshells inside "" quoted ;; regions correctly. - ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)" + ("\"\\(?:[^\\\"]\\|\\\\.\\)*?\\(\\$(\\|`\\)" (1 (ignore (if (nth 8 (save-excursion (syntax-ppss (match-beginning 0)))) (goto-char (1+ (match-beginning 0))) @@ -1196,20 +1134,8 @@ and command `sh-reset-indent-vars-to-global-values'." :options '(sh-electric-here-document-mode) :group 'sh-script) -(defcustom sh-learn-basic-offset nil - "When `sh-guess-basic-offset' should learn `sh-basic-offset'. - -nil mean: never. -t means: only if there seems to be an obvious value. -Anything else means: whenever we have a \"good guess\" as to the value." - :type '(choice - (const :tag "Never" nil) - (const :tag "Only if sure" t) - (const :tag "If have a good guess" usually)) - :group 'sh-indentation) - (defcustom sh-popup-occur-buffer nil - "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. + "Controls when `smie-config-guess' pops the `*indent*' buffer. If t it is always shown. If nil, it is shown only when there are conflicts." :type '(choice @@ -1217,14 +1143,6 @@ are conflicts." (const :tag "Always" t)) :group 'sh-indentation) -(defcustom sh-blink t - "If non-nil, `sh-show-indent' shows the line indentation is relative to. -The position on the line is not necessarily meaningful. -In some cases the line will be the matching keyword, but this is not -always the case." - :type 'boolean - :group 'sh-indentation) - (defcustom sh-first-lines-indent 0 "The indentation of the first non-blank non-comment line. Usually 0 meaning first column. @@ -1567,11 +1485,9 @@ following commands are available, based on the current shell's syntax: \\[sh-while] while loop For sh and rc shells indentation commands are: -\\[sh-show-indent] Show the variable controlling this line's indentation. -\\[sh-set-indent] Set then variable controlling this line's indentation. -\\[sh-learn-line-indent] Change the indentation variable so this line -would indent to the way it currently is. -\\[sh-learn-buffer-indent] Set the indentation variables so the +\\[smie-config-show-indent] Show the rules controlling this line's indentation. +\\[smie-config-set-indent] Change the rules controlling this line's indentation. +\\[smie-config-guess] Try to tweak the indentation rules so the buffer indents as it currently is indented. @@ -1738,13 +1654,6 @@ This adds rules for comments and assignments." (require 'smie) -;; The SMIE code should generally be preferred, but it currently does not obey -;; the various indentation custom-vars, and it misses some important features -;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent, -;; sh-name/save/load-style. -(defvar sh-use-smie t - "Whether to use the SMIE code for navigation and indentation.") - (defun sh-smie--keyword-p () "Non-nil if we're at a keyword position. A keyword position is one where if we're looking at something that looks @@ -2279,60 +2188,6 @@ Point should be before the newline." (defvar sh-regexp-for-done nil "A buffer-local regexp to match opening keyword for done.") -(defvar sh-kw-alist nil - "A buffer-local, since it is shell-type dependent, list of keywords.") - -;; ( key-word first-on-this on-prev-line ) -;; This is used to set `sh-kw-alist' which is a list of sublists each -;; having 3 elements: -;; a keyword -;; a rule to check when the keyword appears on "this" line -;; a rule to check when the keyword appears on "the previous" line -;; The keyword is usually a string and is the first word on a line. -;; If this keyword appears on the line whose indentation is to be -;; calculated, the rule in element 2 is called. If this returns -;; non-zero, the resulting point (which may be changed by the rule) -;; is used as the default indentation. -;; If it returned false or the keyword was not found in the table, -;; then the keyword from the previous line is looked up and the rule -;; in element 3 is called. In this case, however, -;; `sh-get-indent-info' does not stop but may keep going and test -;; other keywords against rules in element 3. This is because the -;; preceding line could have, for example, an opening "if" and an -;; opening "while" keyword and we need to add the indentation offsets -;; for both. -;; -(defconst sh-kw - '((sh - ("if" nil sh-handle-prev-if) - ("elif" sh-handle-this-else sh-handle-prev-else) - ("else" sh-handle-this-else sh-handle-prev-else) - ("fi" sh-handle-this-fi sh-handle-prev-fi) - ("then" sh-handle-this-then sh-handle-prev-then) - ("(" nil sh-handle-prev-open) - ("{" nil sh-handle-prev-open) - ("[" nil sh-handle-prev-open) - ("}" sh-handle-this-close nil) - (")" sh-handle-this-close nil) - ("]" sh-handle-this-close nil) - ("case" nil sh-handle-prev-case) - ("esac" sh-handle-this-esac sh-handle-prev-esac) - (case-label nil sh-handle-after-case-label) ;; ??? - (";;" nil sh-handle-prev-case-alt-end) ;; ??? - (";;&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. - (";&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. - ("done" sh-handle-this-done sh-handle-prev-done) - ("do" sh-handle-this-do sh-handle-prev-do)) - - ;; Note: we don't need specific stuff for bash and zsh shells; - ;; the regexp `sh-regexp-for-done' handles the extra keywords - ;; these shells use. - (rc - ("{" nil sh-handle-prev-open) - ("}" sh-handle-this-close nil) - ("case" sh-handle-this-rc-case sh-handle-prev-rc-case)))) - - (defun sh-set-shell (shell &optional no-query-flag insert-flag) "Set this buffer's shell to SHELL (a string). @@ -2351,8 +2206,7 @@ Shell script files can cause this function be called automatically when the file is visited by having a `sh-shell' file-local variable whose value is the shell name (don't quote it)." (interactive (list (completing-read - (format "Shell (default %s): " - sh-shell-file) + (format-prompt "Shell" sh-shell-file) ;; This used to use interpreter-mode-alist, but that is ;; no longer appropriate now that uses regexps. ;; Maybe there could be a separate variable that lists @@ -2400,16 +2254,6 @@ whose value is the shell name (don't quote it)." (funcall mksym "rules") :forward-token (funcall mksym "forward-token") :backward-token (funcall mksym "backward-token"))) - (unless sh-use-smie - (setq-local sh-kw-alist (sh-feature sh-kw)) - (let ((regexp (sh-feature sh-kws-for-done))) - (if regexp - (setq-local sh-regexp-for-done - (sh-mkword-regexpr (regexp-opt regexp t))))) - (message "setting up indent stuff") - ;; sh-mode has already made indent-line-function local - ;; but do it in case this is called before that. - (setq-local indent-line-function #'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) @@ -2564,11 +2408,6 @@ region, clear header." (eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2))) ;; Indentation stuff. -(defun sh-must-support-indent () - "Signal an error if the shell type for this buffer is not supported. -Also, the buffer must be in Shell-script mode." - (unless sh-indent-supported-here - (error "This buffer's shell does not support indentation through Emacs"))) (defun sh-make-vars-local () "Make the indentation variables local to this buffer. @@ -2589,654 +2428,12 @@ Then, if variable `sh-make-vars-local' is non-nil, make them local." (if sh-make-vars-local (mapcar 'make-local-variable sh-var-list))) - -;; Theoretically these are only needed in shell and derived modes. -;; However, the routines which use them are only called in those modes. -(defconst sh-special-keywords "then\\|do") - -(defun sh-help-string-for-variable (var) - "Construct a string for `sh-read-variable' when changing variable VAR ." - (let ((msg (documentation-property var 'variable-documentation)) - (msg2 "")) - (unless (memq var '(sh-first-lines-indent sh-indent-comment)) - (setq msg2 - (format "\n -You can enter a number (positive to increase indentation, -negative to decrease indentation, zero for no change to indentation). - -Or, you can enter one of the following symbols which are relative to -the value of variable `sh-basic-offset' -which in this buffer is currently %s. - -\t%s." - sh-basic-offset - (mapconcat (lambda (x) - (nth (1- (length x)) x)) - sh-symbol-list "\n\t")))) - (concat - ;; The following shows the global not the local value! - ;; (format "Current value of %s is %s\n\n" var (symbol-value var)) - msg msg2))) - -(defun sh-read-variable (var) - "Read a new value for indentation variable VAR." - (let ((minibuffer-help-form `(sh-help-string-for-variable - (quote ,var))) - val) - (setq val (read-from-minibuffer - (format "New value for %s (press %s for help): " - var (single-key-description help-char)) - (format "%s" (symbol-value var)) - nil t)) - val)) - - - (defun sh-in-comment-or-string (start) "Return non-nil if START is in a comment or string." (save-excursion (let ((state (syntax-ppss start))) (or (nth 3 state) (nth 4 state))))) -(defun sh-goto-matching-if () - "Go to the matching if for a fi. -This handles nested if..fi pairs." - (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1))) - (if found - (goto-char found)))) - - -;; Functions named sh-handle-this-XXX are called when the keyword on the -;; line whose indentation is being handled contain XXX; -;; those named sh-handle-prev-XXX are when XXX appears on the previous line. - -(defun sh-handle-prev-if () - (list '(+ sh-indent-after-if))) - -(defun sh-handle-this-else () - (if (sh-goto-matching-if) - ;; (list "aligned to if") - (list "aligned to if" '(+ sh-indent-for-else)) - nil - )) - -(defun sh-handle-prev-else () - (if (sh-goto-matching-if) - (list '(+ sh-indent-after-if)) - )) - -(defun sh-handle-this-fi () - (if (sh-goto-matching-if) - (list "aligned to if" '(+ sh-indent-for-fi)) - nil - )) - -(defun sh-handle-prev-fi () - ;; Why do we have this rule? Because we must go back to the if - ;; to get its indent. We may continue back from there. - ;; We return nil because we don't have anything to add to result, - ;; the side affect of setting align-point is all that matters. - ;; we could return a comment (a string) but I can't think of a good one... - (sh-goto-matching-if) - nil) - -(defun sh-handle-this-then () - (let ((p (sh-goto-matching-if))) - (if p - (list '(+ sh-indent-for-then)) - ))) - -(defun sh-handle-prev-then () - (let ((p (sh-goto-matching-if))) - (if p - (list '(+ sh-indent-after-if)) - ))) - -(defun sh-handle-prev-open () - (save-excursion - (let ((x (sh-prev-stmt))) - (if (and x - (progn - (goto-char x) - (or - (looking-at "function\\b") - (looking-at "\\s-*\\S-+\\s-*()") - ))) - (list '(+ sh-indent-after-function)) - (list '(+ sh-indent-after-open))) - ))) - -(defun sh-handle-this-close () - (forward-char 1) ;; move over ")" - (if (sh-safe-forward-sexp -1) - (list "aligned to opening paren"))) - -(defun sh-goto-matching-case () - (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1))) - (if found (goto-char found)))) - -(defun sh-handle-prev-case () - ;; This is typically called when point is on same line as a case - ;; we shouldn't -- and can't find prev-case - (if (looking-at ".*\\<case\\>") - (list '(+ sh-indent-for-case-label)) - (error "We don't seem to be on a line with a case"))) ;; debug - -(defun sh-handle-this-esac () - (if (sh-goto-matching-case) - (list "aligned to matching case"))) - -(defun sh-handle-prev-esac () - (if (sh-goto-matching-case) - (list "matching case"))) - -(defun sh-handle-after-case-label () - (if (sh-goto-matching-case) - (list '(+ sh-indent-for-case-alt)))) - -(defun sh-handle-prev-case-alt-end () - (if (sh-goto-matching-case) - (list '(+ sh-indent-for-case-label)))) - -(defun sh-safe-forward-sexp (&optional arg) - "Try and do a `forward-sexp', but do not error. -Return new point if successful, nil if an error occurred." - (condition-case nil - (progn - (forward-sexp (or arg 1)) - (point)) ;; return point if successful - (error - (sh-debug "oops!(1) %d" (point)) - nil))) ;; return nil if fail - -(defun sh-goto-match-for-done () - (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1))) - (if found - (goto-char found)))) - -(defun sh-handle-this-done () - (if (sh-goto-match-for-done) - (list "aligned to do stmt" '(+ sh-indent-for-done)))) - -(defun sh-handle-prev-done () - (if (sh-goto-match-for-done) - (list "previous done"))) - -(defun sh-handle-this-do () - (if (sh-goto-match-for-done) - (list '(+ sh-indent-for-do)))) - -(defun sh-handle-prev-do () - (cond - ((save-restriction - (narrow-to-region (point) (line-beginning-position)) - (sh-goto-match-for-done)) - (sh-debug "match for done found on THIS line") - (list '(+ sh-indent-after-loop-construct))) - ((sh-goto-match-for-done) - (sh-debug "match for done found on PREV line") - (list '(+ sh-indent-after-do))) - (t - (message "match for done NOT found") - nil))) - -;; for rc: -(defun sh-find-prev-switch () - "Find the line for the switch keyword matching this line's case keyword." - (re-search-backward "\\<switch\\>" nil t)) - -(defun sh-handle-this-rc-case () - (if (sh-find-prev-switch) - (list '(+ sh-indent-after-switch)) - ;; (list '(+ sh-indent-for-case-label)) - nil)) - -(defun sh-handle-prev-rc-case () - (list '(+ sh-indent-after-case))) - -(defun sh-check-rule (n thing) - (let ((rule (nth n (assoc thing sh-kw-alist))) - (val nil)) - (if rule - (progn - (setq val (funcall rule)) - (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s" - n thing (point) rule val))) - val)) - - -(defun sh-get-indent-info () - "Return indent-info for this line. -This is a list. nil means the line is to be left as is. -Otherwise it contains one or more of the following sublists: -\(t NUMBER) NUMBER is the base location in the buffer that indentation is - relative to. If present, this is always the first of the - sublists. The indentation of the line in question is - derived from the indentation of this point, possibly - modified by subsequent sublists. -\(+ VAR) -\(- VAR) Get the value of variable VAR and add to or subtract from - the indentation calculated so far. -\(= VAR) Get the value of variable VAR and *replace* the - indentation with its value. This only occurs for - special variables such as `sh-indent-comment'. -STRING This is ignored for the purposes of calculating - indentation, it is printed in certain cases to help show - what the indentation is based on." - ;; See comments before `sh-kw'. - (save-excursion - (let ((have-result nil) - this-kw - val - (result nil) - (align-point nil) - prev-line-end x) - (beginning-of-line) - ;; Note: setting result to t means we are done and will return nil. - ;;(This function never returns just t.) - (cond - ((or (nth 3 (syntax-ppss (point))) - (eq (get-text-property (point) 'face) 'sh-heredoc)) - ;; String continuation -- don't indent - (setq result t) - (setq have-result t)) - ((looking-at "\\s-*#") ; was (equal this-kw "#") - (if (bobp) - (setq result t) ;; return nil if 1st line! - (setq result (list '(= sh-indent-comment))) - ;; we still need to get previous line in case - ;; sh-indent-comment is t (indent as normal) - (setq align-point (sh-prev-line nil)) - (setq have-result nil) - )) - ) ;; cond - - (unless have-result - ;; Continuation lines are handled specially - (if (sh-this-is-a-continuation) - (progn - (setq result - (if (save-excursion - (beginning-of-line) - (not (memq (char-before (- (point) 2)) '(?\s ?\t)))) - ;; By convention, if the continuation \ is not - ;; preceded by a SPC or a TAB it means that the line - ;; is cut at a place where spaces cannot be freely - ;; added/removed. I.e. do not indent the line. - (list '(= nil)) - ;; We assume the line being continued is already - ;; properly indented... - ;; (setq prev-line-end (sh-prev-line)) - (setq align-point (sh-prev-line nil)) - (list '(+ sh-indent-for-continuation)))) - (setq have-result t)) - (beginning-of-line) - (skip-chars-forward " \t") - (setq this-kw (sh-get-kw))) - - ;; Handle "this" keyword: first word on the line we're - ;; calculating indentation info for. - (if this-kw - (if (setq val (sh-check-rule 1 this-kw)) - (progn - (setq align-point (point)) - (sh-debug - "this - setting align-point to %d" align-point) - (setq result (append result val)) - (setq have-result t) - ;; set prev-line to continue processing remainder - ;; of this line as a previous line - (setq prev-line-end (point)) - )))) - - (unless have-result - (setq prev-line-end (sh-prev-line 'end))) - - (if prev-line-end - (save-excursion - ;; We start off at beginning of this line. - ;; Scan previous statements while this is <= - ;; start of previous line. - (goto-char prev-line-end) - (setq x t) - (while (and x (setq x (sh-prev-thing))) - (sh-debug "at %d x is: %s result is: %s" (point) x result) - (cond - ((and (equal x ")") - (equal (get-text-property (1- (point)) 'syntax-table) - sh-st-punc)) - (sh-debug "Case label) here") - (setq x 'case-label) - (if (setq val (sh-check-rule 2 x)) - (progn - (setq result (append result val)) - (setq align-point (point)))) - (or (bobp) - (forward-char -1)) - (skip-chars-forward "*0-9?[]a-z") - ) - ((string-match "[])}]" x) - (setq x (sh-safe-forward-sexp -1)) - (if x - (progn - (setq align-point (point)) - (setq result (append result - (list "aligned to opening paren"))) - ))) - ((string-match "[[({]" x) - (sh-debug "Checking special thing: %s" x) - (if (setq val (sh-check-rule 2 x)) - (setq result (append result val))) - (forward-char -1) - (setq align-point (point))) - ((string-match "[\"'`]" x) - (sh-debug "Skipping back for %s" x) - ;; this was oops-2 - (setq x (sh-safe-forward-sexp -1))) - ((stringp x) - (sh-debug "Checking string %s at %s" x (point)) - (if (setq val (sh-check-rule 2 x)) - ;; (or (eq t (car val)) - ;; (eq t (car (car val)))) - (setq result (append result val))) - ;; not sure about this test Wed Jan 27 23:48:35 1999 - (setq align-point (point)) - (unless (bolp) - (forward-char -1))) - (t - (error "Don't know what to do with %s" x)) - ) - ) ;; while - (sh-debug "result is %s" result) - ) - (sh-debug "No prev line!") - (sh-debug "result: %s align-point: %s" result align-point) - ) - - (if align-point - ;; was: (setq result (append result (list (list t align-point)))) - (setq result (append (list (list t align-point)) result)) - ) - (sh-debug "result is now: %s" result) - - (or result - (setq result (list (if prev-line-end - (list t prev-line-end) - (list '= 'sh-first-lines-indent))))) - - (if (eq result t) - (setq result nil)) - (sh-debug "result is: %s" result) - result - ) ;; let - )) - - -(defun sh-get-indent-var-for-line (&optional info) - "Return the variable controlling indentation for this line. -If there is not [just] one such variable, return a string -indicating the problem. -If INFO is supplied it is used, else it is calculated." - (let ((var nil) - (result nil) - (reason nil) - sym elt) - (or info - (setq info (sh-get-indent-info))) - (if (null info) - (setq result "this line to be left as is") - (while (and info (null result)) - (setq elt (car info)) - (cond - ((stringp elt) - (setq reason elt) - ) - ((not (listp elt)) - (error "sh-get-indent-var-for-line invalid elt: %s" elt)) - ;; so it is a list - ((eq t (car elt)) - ) ;; nothing - ((symbolp (setq sym (nth 1 elt))) - ;; A bit of a kludge - when we see the sh-indent-comment - ;; ignore other variables. Otherwise it is tricky to - ;; "learn" the comment indentation. - (if (eq var 'sh-indent-comment) - (setq result var) - (if var - (setq result - "this line is controlled by more than 1 variable.") - (setq var sym)))) - (t - (error "sh-get-indent-var-for-line invalid list elt: %s" elt))) - (setq info (cdr info)) - )) - (or result - (setq result var)) - (or result - (setq result reason)) - (if (null result) - ;; e.g. just had (t POS) - (setq result "line has default indentation")) - result)) - - - -;; Finding the previous line isn't trivial. -;; We must *always* go back one more and see if that is a continuation -;; line -- it is the PREVIOUS line which is continued, not the one -;; we are going to! -;; Also, we want to treat a whole "here document" as one big line, -;; because we may want to align to the beginning of it. -;; -;; What we do: -;; - go back to previous non-empty line -;; - if this is in a here-document, go to the beginning of it -;; - while previous line is continued, go back one line -(defun sh-prev-line (&optional end) - "Back to end of previous non-comment non-empty line. -Go to beginning of logical line unless END is non-nil, in which case -we go to the end of the previous line and do not check for continuations." - (save-excursion - (beginning-of-line) - (forward-comment (- (point-max))) - (unless end (beginning-of-line)) - (when (and (not (bobp)) - (eq (get-text-property (1- (point)) 'face) 'sh-heredoc)) - (let ((p1 (previous-single-property-change (1- (point)) 'face))) - (when p1 - (goto-char p1) - (if end - (end-of-line) - (beginning-of-line))))) - (unless end - ;; we must check previous lines to see if they are continuation lines - ;; if so, we must return position of first of them - (while (and (sh-this-is-a-continuation) - (>= 0 (forward-line -1)))) - (beginning-of-line) - (skip-chars-forward " \t")) - (point))) - - -(defun sh-prev-stmt () - "Return the address of the previous stmt or nil." - ;; This is used when we are trying to find a matching keyword. - ;; Searching backward for the keyword would certainly be quicker, but - ;; it is hard to remove "false matches" -- such as if the keyword - ;; appears in a string or quote. This way is slower, but (I think) safer. - (interactive) - (save-excursion - (let ((going t) - (start (point)) - (found nil) - (prev nil)) - (skip-chars-backward " \t;|&({[") - (while (and (not found) - (not (bobp)) - going) - ;; Do a backward-sexp if possible, else backup bit by bit... - (if (sh-safe-forward-sexp -1) - (progn - (if (looking-at sh-special-keywords) - (progn - (setq found prev)) - (setq prev (point)) - )) - ;; backward-sexp failed - (if (zerop (skip-chars-backward " \t()[]{};`'")) - (forward-char -1)) - (if (bolp) - (let ((back (sh-prev-line nil))) - (if back - (goto-char back) - (setq going nil))))) - (unless found - (skip-chars-backward " \t") - (if (or (and (bolp) (not (sh-this-is-a-continuation))) - (eq (char-before) ?\;) - (looking-at "\\s-*[|&]")) - (setq found (point))))) - (if found - (goto-char found)) - (if found - (progn - (skip-chars-forward " \t|&({[") - (setq found (point)))) - (if (>= (point) start) - (progn - (debug "We didn't move!") - (setq found nil)) - (or found - (sh-debug "Did not find prev stmt."))) - found))) - - -(defun sh-get-word () - "Get a shell word skipping whitespace from point." - (interactive) - (skip-chars-forward "\t ") - (let ((start (point))) - (while - (if (looking-at "[\"'`]") - (sh-safe-forward-sexp) - ;; (> (skip-chars-forward "^ \t\n\"'`") 0) - (> (skip-chars-forward "-_$[:alnum:]") 0) - )) - (buffer-substring start (point)) - )) - -(defun sh-prev-thing () - "Return the previous thing this logical line." - ;; This is called when `sh-get-indent-info' is working backwards on - ;; the previous line(s) finding what keywords may be relevant for - ;; indenting. It moves over sexps if possible, and will stop - ;; on a ; and at the beginning of a line if it is not a continuation - ;; line. - ;; - ;; Added a kludge for ";;" - ;; Possible return values: - ;; nil - nothing - ;; a string - possibly a keyword - ;; - (if (bolp) - nil - (let ((start (point)) - (min-point (if (sh-this-is-a-continuation) - (sh-prev-line nil) - (line-beginning-position)))) - (skip-chars-backward " \t;" min-point) - (if (looking-at "\\s-*;[;&]") - ;; (message "Found ;; !") - ";;" - (skip-chars-backward "^)}];\"'`({[" min-point) - (let ((c (if (> (point) min-point) (char-before)))) - (sh-debug "stopping at %d c is %s start=%d min-point=%d" - (point) c start min-point) - (if (not (memq c '(?\n nil ?\;))) - ;; c -- return a string - (char-to-string c) - ;; Return the leading keyword of the "command" we supposedly - ;; skipped over. Maybe we skipped too far (e.g. past a `do' or - ;; `then' that precedes the actual command), so check whether - ;; we're looking at such a keyword and if so, move back forward. - (let ((boundary (point)) - kwd next) - (while - (progn - ;; Skip forward over white space newline and \ at eol. - (skip-chars-forward " \t\n\\\\" start) - (if (>= (point) start) - (progn - (sh-debug "point: %d >= start: %d" (point) start) - nil) - (if next (setq boundary next)) - (sh-debug "Now at %d start=%d" (point) start) - (setq kwd (sh-get-word)) - (if (member kwd (sh-feature sh-leading-keywords)) - (progn - (setq next (point)) - t) - nil)))) - (goto-char boundary) - kwd))))))) - - -(defun sh-this-is-a-continuation () - "Return non-nil if current line is a continuation of previous line." - (save-excursion - (and (zerop (forward-line -1)) - (looking-at ".*\\\\$") - (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0) - nil nil nil t)))))) - -(defun sh-get-kw (&optional where and-move) - "Return first word of line from WHERE. -If AND-MOVE is non-nil then move to end of word." - (let ((start (point))) - (if where - (goto-char where)) - (prog1 - (buffer-substring (point) - (progn (skip-chars-forward "^ \t\n;&|")(point))) - (unless and-move - (goto-char start))))) - -(defun sh-find-prev-matching (open close &optional depth) - "Find a matching token for a set of opening and closing keywords. -This takes into account that there may be nested open..close pairings. -OPEN and CLOSE are regexps denoting the tokens to be matched. -Optional parameter DEPTH (usually 1) says how many to look for." - (let ((parse-sexp-ignore-comments t) - (forward-sexp-function nil) - prev) - (setq depth (or depth 1)) - (save-excursion - (condition-case nil - (while (and - (/= 0 depth) - (not (bobp)) - (setq prev (sh-prev-stmt))) - (goto-char prev) - (save-excursion - (if (looking-at "\\\\\n") - (progn - (forward-char 2) - (skip-chars-forward " \t"))) - (cond - ((looking-at open) - (setq depth (1- depth)) - (sh-debug "found open at %d - depth = %d" (point) depth)) - ((looking-at close) - (setq depth (1+ depth)) - (sh-debug "found close - depth = %d" depth)) - (t - )))) - (error nil)) - (if (eq depth 0) - prev ;; (point) - nil) - ))) - (defun sh-var-value (var &optional ignore-error) "Return the value of variable VAR, interpreting symbols. @@ -3268,620 +2465,16 @@ IGNORE-ERROR is non-nil." "Don't know how to handle %s's value of %s" var val) 0)))) -(defun sh-set-var-value (var value &optional no-symbol) - "Set variable VAR to VALUE. -Unless optional argument NO-SYMBOL is non-nil, then if VALUE is -can be represented by a symbol then do so." - (cond - (no-symbol - (set var value)) - ((= value sh-basic-offset) - (set var '+)) - ((= value (- sh-basic-offset)) - (set var '-)) - ((eq value (* 2 sh-basic-offset)) - (set var '++)) - ((eq value (* 2 (- sh-basic-offset))) - (set var '--)) - ((eq value (/ sh-basic-offset 2)) - (set var '*)) - ((eq value (/ (- sh-basic-offset) 2)) - (set var '/)) - (t - (set var value))) - ) - - -(defun sh-calculate-indent (&optional info) - "Return the indentation for the current line. -If INFO is supplied it is used, else it is calculated from current line." - (let ((ofs 0) - (base-value 0) - elt a b val) - (or info - (setq info (sh-get-indent-info))) - (when info - (while info - (sh-debug "info: %s ofs=%s" info ofs) - (setq elt (car info)) - (cond - ((stringp elt)) ;; do nothing? - ((listp elt) - (setq a (car (car info))) - (setq b (nth 1 (car info))) - (cond - ((eq a t) - (save-excursion - (goto-char b) - (setq val (current-indentation))) - (setq base-value val)) - ((symbolp b) - (setq val (sh-var-value b)) - (cond - ((eq a '=) - (cond - ((null val) - ;; no indentation - ;; set info to nil so we stop immediately - (setq base-value nil ofs nil info nil)) - ((eq val t) (setq ofs 0)) ;; indent as normal line - (t - ;; The following assume the (t POS) come first! - (setq ofs val base-value 0) - (setq info nil)))) ;; ? stop now - ((eq a '+) (setq ofs (+ ofs val))) - ((eq a '-) (setq ofs (- ofs val))) - (t - (error "sh-calculate-indent invalid a a=%s b=%s" a b)))) - (t - (error "sh-calculate-indent invalid elt: a=%s b=%s" a b)))) - (t - (error "sh-calculate-indent invalid elt %s" elt))) - (sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s" - a b val base-value ofs) - (setq info (cdr info))) - ;; return value: - (sh-debug "at end: base-value: %s ofs: %s" base-value ofs) - - (cond - ((or (null base-value)(null ofs)) - nil) - ((and (numberp base-value)(numberp ofs)) - (sh-debug "base (%d) + ofs (%d) = %d" - base-value ofs (+ base-value ofs)) - (+ base-value ofs)) ;; return value - (t - (error "sh-calculate-indent: Help. base-value=%s ofs=%s" - base-value ofs) - nil))))) +(define-obsolete-function-alias 'sh-show-indent + #'smie-config-show-indent "28.1") +(define-obsolete-function-alias 'sh-set-indent #'smie-config-set-indent "28.1") -(defun sh-indent-line () - "Indent the current line." - (interactive) - (let ((indent (sh-calculate-indent)) - (pos (- (point-max) (point)))) - (when indent - (beginning-of-line) - (skip-chars-forward " \t") - (indent-line-to indent) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))))) - - -(defun sh-blink (blinkpos &optional msg) - "Move cursor momentarily to BLINKPOS and display MSG." - ;; We can get here without it being a number on first line - (if (numberp blinkpos) - (save-excursion - (goto-char blinkpos) - (if msg (message "%s" msg) (message nil)) - (sit-for blink-matching-delay)) - (if msg (message "%s" msg) (message nil)))) - -(defun sh-show-indent (arg) - "Show how the current line would be indented. -This tells you which variable, if any, controls the indentation of -this line. -If optional arg ARG is non-null (called interactively with a prefix), -a pop up window describes this variable. -If variable `sh-blink' is non-nil then momentarily go to the line -we are indenting relative to, if applicable." - (interactive "P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-show-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - (curr-indent (current-indentation)) - val msg) - (if (stringp var) - (message "%s" (setq msg var)) - (setq val (sh-calculate-indent info)) - - (if (eq curr-indent val) - (setq msg (format "%s is %s" var (symbol-value var))) - (setq msg - (if val - (format "%s (%s) would change indent from %d to: %d" - var (symbol-value var) curr-indent val) - (format "%s (%s) would leave line as is" - var (symbol-value var))) - )) - (if (and arg var) - (describe-variable var))) - (if sh-blink - (let ((info (sh-get-indent-info))) - (if (and info (listp (car info)) - (eq (car (car info)) t)) - (sh-blink (nth 1 (car info)) msg) - (message "%s" msg))) - (message "%s" msg)) - ))) +(define-obsolete-function-alias 'sh-learn-line-indent + #'smie-config-set-indent "28.1") -(defun sh-set-indent () - "Set the indentation for the current line. -If the current line is controlled by an indentation variable, prompt -for a new value for it." - (interactive) - (sh-must-support-indent) - (if sh-use-smie - (smie-config-set-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - val old-val indent-val) - (if (stringp var) - (message "Cannot set indent - %s" var) - (setq old-val (symbol-value var)) - (setq val (sh-read-variable var)) - (condition-case nil - (progn - (set var val) - (setq indent-val (sh-calculate-indent info)) - (if indent-val - (message "Variable: %s Value: %s would indent to: %d" - var (symbol-value var) indent-val) - (message "Variable: %s Value: %s would leave line as is." - var (symbol-value var))) - ;; I'm not sure about this, indenting it now? - ;; No. Because it would give the impression that an undo would - ;; restore thing, but the value has been altered. - ;; (sh-indent-line) - ) - (error - (set var old-val) - (message "Bad value for %s, restoring to previous value %s" - var old-val) - (sit-for 1) - nil)) - )))) - - -(defun sh-learn-line-indent (arg) - "Learn how to indent a line as it currently is indented. - -If there is an indentation variable which controls this line's indentation, -then set it to a value which would indent the line the way it -presently is. - -If the value can be represented by one of the symbols then do so -unless optional argument ARG (the prefix when interactive) is non-nil." - (interactive "*P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-set-indent) - ;; I'm not sure if we show allow learning on an empty line. - ;; Though it might occasionally be useful I think it usually - ;; would just be confusing. - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*$")) - (message "sh-learn-line-indent ignores empty lines.") - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - ival sval diff new-val - (no-symbol arg) - (curr-indent (current-indentation))) - (cond - ((stringp var) - (message "Cannot learn line - %s" var)) - ((eq var 'sh-indent-comment) - ;; This is arbitrary... - ;; - if curr-indent is 0, set to curr-indent - ;; - else if it has the indentation of a "normal" line, - ;; then set to t - ;; - else set to curr-indent. - (setq sh-indent-comment - (if (= curr-indent 0) - 0 - (let* ((sh-indent-comment t) - (val2 (sh-calculate-indent info))) - (if (= val2 curr-indent) - t - curr-indent)))) - (message "%s set to %s" var (symbol-value var)) - ) - ((numberp (setq sval (sh-var-value var))) - (setq ival (sh-calculate-indent info)) - (setq diff (- curr-indent ival)) - - (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" - curr-indent ival diff var sval) - (setq new-val (+ sval diff)) - ;; I commented out this because someone might want to replace - ;; a value of `+' with the current value of sh-basic-offset - ;; or vice-versa. - ;;(if (= 0 diff) - ;; (message "No change needed!") - (sh-set-var-value var new-val no-symbol) - (message "%s set to %s" var (symbol-value var)) - ) - (t - (debug) - (message "Cannot change %s" var))))))) - - - -(defun sh-mark-init (buffer) - "Initialize a BUFFER to be used by `sh-mark-line'." - (with-current-buffer (get-buffer-create buffer) - (erase-buffer) - (occur-mode))) - - -(defun sh-mark-line (message point buffer &optional add-linenum occur-point) - "Insert MESSAGE referring to location POINT in current buffer into BUFFER. -Buffer BUFFER is in `occur-mode'. -If ADD-LINENUM is non-nil the message is preceded by the line number. -If OCCUR-POINT is non-nil then the line is marked as a new occurrence -so that `occur-next' and `occur-prev' will work." - (let ((m1 (make-marker)) - start - (line "")) - (when point - (set-marker m1 point (current-buffer)) - (if add-linenum - (setq line (format "%d: " (1+ (count-lines 1 point)))))) - (save-excursion - (if (get-buffer buffer) - (set-buffer (get-buffer buffer)) - (set-buffer (get-buffer-create buffer)) - (occur-mode) - ) - (goto-char (point-max)) - (setq start (point)) - (let ((inhibit-read-only t)) - (insert line) - (if occur-point - (setq occur-point (point))) - (insert message) - (if point - (add-text-properties - start (point) - '(mouse-face highlight - help-echo "mouse-2: go to the line where I learned this"))) - (insert "\n") - (when point - (put-text-property start (point) 'occur-target m1) - (if occur-point - (put-text-property start occur-point - 'occur-match t)) - ))))) - -;; Is this really worth having? -(defvar sh-learned-buffer-hook nil - "An abnormal hook, called with an alist of learned variables.") -;; Example of how to use sh-learned-buffer-hook -;; -;; (defun what-i-learned (list) -;; (let ((p list)) -;; (with-current-buffer "*scratch*" -;; (goto-char (point-max)) -;; (insert "(setq\n") -;; (while p -;; (insert (format " %s %s \n" -;; (nth 0 (car p)) (nth 1 (car p)))) -;; (setq p (cdr p))) -;; (insert ")\n") -;; ))) -;; -;; (add-hook 'sh-learned-buffer-hook #'what-i-learned) - - -;; Originally this was sh-learn-region-indent (beg end) -;; However, in practice this was awkward so I changed it to -;; use the whole buffer. Use narrowing if need be. -(defun sh-learn-buffer-indent (&optional arg) - "Learn how to indent the buffer the way it currently is. - -If `sh-use-smie' is non-nil, call `smie-config-guess'. -Otherwise, run the sh-script specific indent learning command, as -described below. - -Output in buffer \"*indent*\" shows any lines which have conflicting -values of a variable, and the final value of all variables learned. -When called interactively, pop to this buffer automatically if -there are any discrepancies. - -If no prefix ARG is given, then variables are set to numbers. -If a prefix arg is given, then variables are set to symbols when -applicable -- e.g. to symbol `+' if the value is that of the -basic indent. -If a positive numerical prefix is given, then `sh-basic-offset' -is set to the prefix's numerical value. -Otherwise, sh-basic-offset may or may not be changed, according -to the value of variable `sh-learn-basic-offset'. - -Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the -function completes. The function is abnormal because it is called -with an alist of variables learned. - -This command can often take a long time to run." - (interactive "P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-guess) - (save-excursion - (goto-char (point-min)) - (let ((learned-var-list nil) - (out-buffer "*indent*") - (num-diffs 0) - previous-set-info - (max 17) - vec - msg - (comment-col nil) ;; number if all same, t if seen diff values - (comments-always-default t) ;; nil if we see one not default - initial-msg - (specified-basic-offset (and arg (numberp arg) - (> arg 0))) - (linenum 0) - suggested) - (setq vec (make-vector max 0)) - (sh-mark-init out-buffer) - - (if specified-basic-offset - (progn - (setq sh-basic-offset arg) - (setq initial-msg - (format "Using specified sh-basic-offset of %d" - sh-basic-offset))) - (setq initial-msg - (format "Initial value of sh-basic-offset: %s" - sh-basic-offset))) - - (while (< (point) (point-max)) - (setq linenum (1+ linenum)) - ;; (if (zerop (% linenum 10)) - (message "line %d" linenum) - ;; ) - (unless (looking-at "\\s-*$") ;; ignore empty lines! - (let* ((sh-indent-comment t) ;; info must return default indent - (info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - sval ival diff new-val - (curr-indent (current-indentation))) - (cond - ((null var) - nil) - ((stringp var) - nil) - ((numberp (setq sval (sh-var-value var 'no-error))) - ;; the numberp excludes comments since sval will be t. - (setq ival (sh-calculate-indent)) - (setq diff (- curr-indent ival)) - (setq new-val (+ sval diff)) - (sh-set-var-value var new-val 'no-symbol) - (unless (looking-at "\\s-*#") ;; don't learn from comments - (if (setq previous-set-info (assoc var learned-var-list)) - (progn - ;; it was already there, is it same value ? - (unless (eq (symbol-value var) - (nth 1 previous-set-info)) - (sh-mark-line - (format "Variable %s was set to %s" - var (symbol-value var)) - (point) out-buffer t t) - (sh-mark-line - (format " but was previously set to %s" - (nth 1 previous-set-info)) - (nth 2 previous-set-info) out-buffer t) - (setq num-diffs (1+ num-diffs)) - ;; (delete previous-set-info learned-var-list) - (setcdr previous-set-info - (list (symbol-value var) (point))) - ) - ) - (setq learned-var-list - (append (list (list var (symbol-value var) - (point))) - learned-var-list))) - (if (numberp new-val) - (progn - (sh-debug - "This line's indent value: %d" new-val) - (if (< new-val 0) - (setq new-val (- new-val))) - (if (< new-val max) - (aset vec new-val (1+ (aref vec new-val)))))) - )) - ((eq var 'sh-indent-comment) - (unless (= curr-indent (sh-calculate-indent info)) - ;; this is not the default indentation - (setq comments-always-default nil) - (if comment-col ;; then we have see one before - (or (eq comment-col curr-indent) - (setq comment-col t)) ;; seen a different one - (setq comment-col curr-indent)) - )) - (t - (sh-debug "Cannot learn this line!!!") - )) - (sh-debug - "at %s learned-var-list is %s" (point) learned-var-list) - )) - (forward-line 1) - ) ;; while - (if sh-debug - (progn - (setq msg (format - "comment-col = %s comments-always-default = %s" - comment-col comments-always-default)) - ;; (message msg) - (sh-mark-line msg nil out-buffer))) - (cond - ((eq comment-col 0) - (setq msg "\nComments are all in 1st column.\n")) - (comments-always-default - (setq msg "\nComments follow default indentation.\n") - (setq comment-col t)) - ((numberp comment-col) - (setq msg (format "\nComments are in col %d." comment-col))) - (t - (setq msg "\nComments seem to be mixed, leaving them as is.\n") - (setq comment-col nil) - )) - (sh-debug msg) - (sh-mark-line msg nil out-buffer) - - (sh-mark-line initial-msg nil out-buffer t t) - - (setq suggested (sh-guess-basic-offset vec)) - - (if (and suggested (not specified-basic-offset)) - (let ((new-value - (cond - ;; t => set it if we have a single value as a number - ((and (eq sh-learn-basic-offset t) (numberp suggested)) - suggested) - ;; other non-nil => set it if only one value was found - (sh-learn-basic-offset - (if (numberp suggested) - suggested - (if (= (length suggested) 1) - (car suggested)))) - (t - nil)))) - (if new-value - (progn - (setq learned-var-list - (append (list (list 'sh-basic-offset - (setq sh-basic-offset new-value) - (point-max))) - learned-var-list)) - ;; Not sure if we need to put this line in, since - ;; it will appear in the "Learned variable settings". - (sh-mark-line - (format "Changed sh-basic-offset to: %d" sh-basic-offset) - nil out-buffer)) - (sh-mark-line - (if (listp suggested) - (format "Possible value(s) for sh-basic-offset: %s" - (mapconcat 'int-to-string suggested " ")) - (format "Suggested sh-basic-offset: %d" suggested)) - nil out-buffer)))) - - - (setq learned-var-list - (append (list (list 'sh-indent-comment comment-col (point-max))) - learned-var-list)) - (setq sh-indent-comment comment-col) - (let ((name (buffer-name))) - (sh-mark-line "\nLearned variable settings:" nil out-buffer) - (if arg - ;; Set learned variables to symbolic rather than numeric - ;; values where possible. - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var)) - (val (nth 1 learned-var))) - (when (and (not (eq var 'sh-basic-offset)) - (numberp val)) - (sh-set-var-value var val))))) - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var))) - (sh-mark-line (format " %s %s" var (symbol-value var)) - (nth 2 learned-var) out-buffer))) - (with-current-buffer out-buffer - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (insert - (format "Indentation values for buffer %s.\n" name) - (format "%d indentation variable%s different values%s\n\n" - num-diffs - (if (= num-diffs 1) - " has" "s have") - (if (zerop num-diffs) - "." ":")))))) - (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) - (and (called-interactively-p 'any) - (or sh-popup-occur-buffer (> num-diffs 0)) - (pop-to-buffer out-buffer)))))) - -(defun sh-guess-basic-offset (vec) - "See if we can determine a reasonable value for `sh-basic-offset'. -This is experimental, heuristic and arbitrary! -Argument VEC is a vector of information collected by -`sh-learn-buffer-indent'. -Return values: - number - there appears to be a good single value - list of numbers - no obvious one, here is a list of one or more - reasonable choices - nil - we couldn't find a reasonable one." - (let* ((max (1- (length vec))) - (i 1) - (totals (make-vector max 0))) - (while (< i max) - (cl-incf (aref totals i) (* 4 (aref vec i))) - (if (zerop (% i 2)) - (cl-incf (aref totals i) (aref vec (/ i 2)))) - (if (< (* i 2) max) - (cl-incf (aref totals i) (aref vec (* i 2)))) - (setq i (1+ i))) - - (let ((x nil) - (result nil) - tot sum p) - (setq i 1) - (while (< i max) - (if (/= (aref totals i) 0) - (push (cons i (aref totals i)) x)) - (setq i (1+ i))) - - (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b))))) - (setq tot (apply '+ (append totals nil))) - (sh-debug (format "vec: %s\ntotals: %s\ntot: %d" - vec totals tot)) - (cond - ((zerop (length x)) - (message "no values!")) ;; we return nil - ((= (length x) 1) - (message "only value is %d" (car (car x))) - (setq result (car (car x)))) ;; return single value - ((> (cdr (car x)) (/ tot 2)) - ;; 1st is > 50% - (message "basic-offset is probably %d" (car (car x))) - (setq result (car (car x)))) ;; again, return a single value - ((>= (cdr (car x)) (* 2 (cdr (car (cdr x))))) - ;; 1st is >= 2 * 2nd - (message "basic-offset could be %d" (car (car x))) - (setq result (car (car x)))) - ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2)) - ;; 1st & 2nd together >= 50% - return a list - (setq p x sum 0 result nil) - (while (and p - (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2))) - (setq result (append result (list (car (car p))))) - (setq p (cdr p))) - (message "Possible choices for sh-basic-offset: %s" - (mapconcat 'int-to-string result " "))) - (t - (message "No obvious value for sh-basic-offset. Perhaps %d" - (car (car x))) - ;; result is nil here - )) - result))) +(define-obsolete-function-alias 'sh-learn-buffer-indent + #'smie-config-guess "28.1") ;; ======================================================================== diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 400e304ecf4..e554b2b8b0b 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -257,7 +257,6 @@ (defcustom sql-user "" "Default username." :type 'string - :group 'SQL :safe 'stringp) (defcustom sql-password "" @@ -265,33 +264,28 @@ If you customize this, the value will be stored in your init file. Since that is a plaintext file, this could be dangerous." :type 'string - :group 'SQL :risky t) (defcustom sql-database "" "Default database." :type 'string - :group 'SQL :safe 'stringp) (defcustom sql-server "" "Default server or host." :type 'string - :group 'SQL :safe 'stringp) (defcustom sql-port 0 "Default port for connecting to a MySQL or Postgres server." :version "24.1" :type 'number - :group 'SQL :safe 'numberp) (defcustom sql-default-directory nil "Default directory for SQL processes." :version "25.1" :type '(choice (const nil) string) - :group 'SQL :safe 'stringp) ;; Login parameter type @@ -461,7 +455,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " - :syntax-alist ((?# . "< b")) + :syntax-alist ((?# . "< b") (?\\ . "\\")) :input-filter sql-remove-tabs-filter) (oracle @@ -707,9 +701,9 @@ making new SQLi sessions." (repeat :inline t (list :tab "Other" (symbol :tag " Variable Symbol") + ;; FIXME: Why "Value *Expression*"? (sexp :tag "Value Expression"))))) - :version "24.1" - :group 'SQL) + :version "24.1") (defvaralias 'sql-dialect 'sql-product) @@ -723,7 +717,6 @@ This allows highlighting buffers properly when you open them." (capitalize (symbol-name (car prod-info)))) ,(car prod-info))) sql-product-alist)) - :group 'SQL :safe 'symbolp) ;; SQL indent support @@ -735,7 +728,6 @@ SQL statements with easy customizations to support varied layout requirements. The package must be available to be loaded and activated." - :group 'SQL :link '(url-link "https://elpa.gnu.org/packages/sql-indent.html") :type 'boolean :version "27.1") @@ -851,7 +843,6 @@ host key." See `sql-password-search-wallet-function' to understand how this value is used to locate the password wallet." :type `(plist-get (symbol-plist 'auth-sources) 'custom-type) - :group 'SQL :version "27.1") (defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet @@ -878,8 +869,7 @@ current input in the SQLi buffer to the process." :type '(choice (const :tag "Nothing" nil) (const :tag "The semicolon `;'" semicolon) (const :tag "The string `go' by itself" go)) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-send-terminator nil "When non-nil, add a terminator to text sent to the SQL interpreter. @@ -905,10 +895,9 @@ it automatically." (const :tag "Default Terminator" t) (string :tag "Terminator String") (cons :tag "Terminator Pattern and String" - (string :tag "Terminator Pattern") + (regexp :tag "Terminator Pattern") (string :tag "Terminator String"))) - :version "22.2" - :group 'SQL) + :version "22.2") (defvar sql-contains-names nil "When non-nil, the current buffer contains database names. @@ -932,8 +921,7 @@ buffer." :type '(choice (const :tag "Default" t) (const :tag "No display" nil) (function :tag "Display Buffer function")) - :version "27.1" - :group 'SQL) + :version "27.1") ;; imenu support for sql-mode. @@ -971,8 +959,7 @@ This is used to initialize `comint-input-ring-file-name'. Note that the size of the input history is determined by the variable `comint-input-ring-size'." :type '(choice (const :tag "none" nil) - (file)) - :group 'SQL) + (file))) (defcustom sql-input-ring-separator "\n--\n" "Separator between commands in the history file. @@ -987,21 +974,18 @@ does not have it, setting `sql-input-ring-separator' will have no effect. In that case multiline commands will be split into several commands when the input history is read, as if you had set `sql-input-ring-separator' to \"\\n\"." - :type 'string - :group 'SQL) + :type 'string) ;; The usual hooks (defcustom sql-interactive-mode-hook '(sql-indent-enable) "Hook for customizing `sql-interactive-mode'." :type 'hook - :group 'SQL :version "27.1") (defcustom sql-mode-hook '(sql-indent-enable) "Hook for customizing `sql-mode'." :type 'hook - :group 'SQL :version "27.1") (defcustom sql-set-sqli-hook '() @@ -1009,8 +993,7 @@ commands when the input history is read, as if you had set This is called by `sql-set-sqli-buffer' when the value of `sql-buffer' is changed." - :type 'hook - :group 'SQL) + :type 'hook) (defcustom sql-login-hook '() "Hook for interacting with a buffer in `sql-interactive-mode'. @@ -1018,8 +1001,7 @@ is changed." This hook is invoked in a buffer once it is ready to accept input for the first time." :version "24.1" - :type 'hook - :group 'SQL) + :type 'hook) ;; Customization for ANSI @@ -1033,8 +1015,7 @@ All products share this list; products should define a regexp to identify additional keywords in a variable defined by the :statement feature." :version "24.1" - :type 'string - :group 'SQL) + :type 'regexp) ;; Customization for Oracle @@ -1046,27 +1027,23 @@ Starts `sql-interactive-mode' after doing some setup. On Windows, \"sqlplus\" usually starts the sqlplus \"GUI\". In order to start the sqlplus console, use \"plus33\" or something similar. You will find the file in your Orant\\bin directory." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-oracle-options '("-L") "List of additional options for `sql-oracle-program'." :type '(repeat string) - :version "24.4" - :group 'SQL) + :version "24.4") (defcustom sql-oracle-login-params '(user password database) "List of login parameters needed to connect to Oracle." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") (defcustom sql-oracle-statement-starters (regexp-opt '("declare" "begin" "with")) "Additional statement starting keywords in Oracle." :version "24.1" - :type 'string - :group 'SQL) + :type 'string) (defcustom sql-oracle-scan-on t "Non-nil if placeholders should be replaced in Oracle SQLi. @@ -1082,8 +1059,7 @@ You need to issue the following command in SQL*Plus to be safe: In older versions of SQL*Plus, this was the SET SCAN OFF command." :version "24.1" - :type 'boolean - :group 'SQL) + :type 'boolean) (defcustom sql-db2-escape-newlines nil "Non-nil if newlines should be escaped by a backslash in DB2 SQLi. @@ -1092,8 +1068,7 @@ When non-nil, Emacs will automatically insert a space and backslash prior to every newline in multi-line SQL statements as they are submitted to an interactive DB2 session." :version "24.3" - :type 'boolean - :group 'SQL) + :type 'boolean) ;; Customization for SQLite @@ -1103,21 +1078,18 @@ they are submitted to an interactive DB2 session." "Command to start SQLite. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-sqlite-options nil "List of additional options for `sql-sqlite-program'." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-sqlite-login-params '((database :file nil :must-match confirm)) "List of login parameters needed to connect to SQLite." :type 'sql-login-params - :version "26.1" - :group 'SQL) + :version "26.1") ;; Customization for MariaDB @@ -1134,22 +1106,19 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start mysql by Oracle. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-mysql-options nil "List of additional options for `sql-mysql-program'. The following list of options is reported to make things work on Windows: \"-C\" \"-t\" \"-f\" \"-n\"." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-mysql-login-params '(user password database server) "List of login parameters needed to connect to MySQL." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Solid @@ -1157,14 +1126,12 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"." "Command to start SOLID SQL Editor. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-solid-login-params '(user password server) "List of login parameters needed to connect to Solid." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Sybase @@ -1172,21 +1139,18 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start isql by Sybase. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-sybase-options nil "List of additional options for `sql-sybase-program'. Some versions of isql might require the -n option in order to work." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-sybase-login-params '(server user password database) "List of login parameters needed to connect to Sybase." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Informix @@ -1194,14 +1158,12 @@ Some versions of isql might require the -n option in order to work." "Command to start dbaccess by Informix. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-informix-login-params '(database) "List of login parameters needed to connect to Informix." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Ingres @@ -1209,14 +1171,12 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start sql by Ingres. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-ingres-login-params '(database) "List of login parameters needed to connect to Ingres." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Microsoft @@ -1229,21 +1189,18 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start osql by Microsoft. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-ms-options '("-w" "300" "-n") ;; -w is the linesize "List of additional options for `sql-ms-program'." :type '(repeat string) - :version "22.1" - :group 'SQL) + :version "22.1") (defcustom sql-ms-login-params '(user password server database) "List of login parameters needed to connect to Microsoft." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Postgres @@ -1251,8 +1208,7 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start psql by Postgres. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-postgres-options '("-P" "pager=off") "List of additional options for `sql-postgres-program'. @@ -1263,8 +1219,7 @@ name, add the string \"-u\" to the list of options. If you want to provide a user name on the command line (newer versions such as 7.1), add your name with a \"-U\" prefix (such as \"-Umark\") to the list." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-postgres-login-params `((user :default ,(user-login-name)) @@ -1275,8 +1230,7 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." server) "List of login parameters needed to connect to Postgres." :type 'sql-login-params - :version "26.1" - :group 'SQL) + :version "26.1") (defun sql-postgres-list-databases () "Return a list of available PostgreSQL databases." @@ -1297,20 +1251,17 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." "Command to start isql by Interbase. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-interbase-options nil "List of additional options for `sql-interbase-program'." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-interbase-login-params '(user password database) "List of login parameters needed to connect to Interbase." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for DB2 @@ -1318,20 +1269,17 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start db2 by IBM. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-db2-options nil "List of additional options for `sql-db2-program'." :type '(repeat string) - :version "20.8" - :group 'SQL) + :version "20.8") (defcustom sql-db2-login-params nil "List of login parameters needed to connect to DB2." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") ;; Customization for Linter @@ -1339,20 +1287,17 @@ Starts `sql-interactive-mode' after doing some setup." "Command to start inl by RELEX. Starts `sql-interactive-mode' after doing some setup." - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-linter-options nil "List of additional options for `sql-linter-program'." :type '(repeat string) - :version "21.3" - :group 'SQL) + :version "21.3") (defcustom sql-linter-login-params '(user password database server) "Login parameters to needed to connect to Linter." :type 'sql-login-params - :version "24.1" - :group 'SQL) + :version "24.1") @@ -1436,10 +1381,7 @@ specified, it's `sql-product' or `sql-connection' must match." (defvar sql-interactive-mode-map (let ((map (make-sparse-keymap))) - (if (fboundp 'set-keymap-parent) - (set-keymap-parent map comint-mode-map); Emacs - (if (fboundp 'set-keymap-parents) - (set-keymap-parents map (list comint-mode-map)))); XEmacs + (set-keymap-parent map comint-mode-map) (if (fboundp 'set-keymap-name) (set-keymap-name map 'sql-interactive-mode-map)); XEmacs (define-key map (kbd "C-j") 'sql-accumulate-and-indent) @@ -2374,7 +2316,8 @@ function `regexp-opt'.") "ansi_warnings" "forceplan" "showplan_all" "showplan_text" "statistics" "implicit_transactions" "remote_proc_transactions" "transaction" "xact_abort" -) t) +) + t) "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$") 'font-lock-doc-face) @@ -2740,7 +2683,7 @@ highlighting rules in SQL mode.") nil 'require-match init 'sql-product-history init)))) -(defun sql-add-product (product display &optional plist) +(defun sql-add-product (product display &rest plist) "Add support for a database product in `sql-mode'. Add PRODUCT to `sql-product-alist' which enables `sql-mode' to @@ -2856,7 +2799,7 @@ See `sql-product-alist' for a list of products and supported features." (member feature sql-indirect-features) (not not-indirect) (symbolp v)) - (eval v) + (symbol-value v) v)) (error "`%s' is not a known product; use `sql-add-product' to add it first." product) nil))) @@ -4244,8 +4187,7 @@ must tell Emacs. Here's how to do that in your init file: \(add-hook \\='sql-mode-hook (lambda () - (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" - :group 'SQL + (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table (if sql-mode-menu @@ -4268,6 +4210,18 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) + (setq-local syntax-propertize-function + (syntax-propertize-rules + ;; Handle escaped apostrophes within strings. + ("''" + (0 + (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (forward-char -1) + nil))) + ;; Propertize rules to not have /- and -* start comments. + ("\\(/-\\)" (1 ".")) + ("\\(-\\*\\)" (1 ".")))) ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 @@ -4280,7 +4234,7 @@ must tell Emacs. Here's how to do that in your init file: (put 'sql-interactive-mode 'mode-class 'special) (put 'sql-interactive-mode 'custom-mode-group 'SQL) ;; FIXME: Why not use `define-derived-mode'? -(defun sql-interactive-mode () +(define-derived-mode sql-interactive-mode comint-mode "SQLi[?]" "Major mode to use a SQL interpreter interactively. Do not call this function by yourself. The environment must be @@ -4348,9 +4302,10 @@ you entered, right above the output it created. \(setq comint-output-filter-functions (function (lambda (STR) (comint-show-output))))" + :syntax-table sql-mode-syntax-table ;; FIXME: The doc above uses `setq' on `comint-output-filter-functions', ;; whereas hooks should be manipulated with things like `add/remove-hook'. - (delay-mode-hooks (comint-mode)) + :after-hook (sql--adjust-interactive-setup) ;; Get the `sql-product' for this interactive session. (set (make-local-variable 'sql-product) @@ -4358,14 +4313,11 @@ you entered, right above the output it created. sql-product)) ;; Setup the mode. - (setq major-mode 'sql-interactive-mode) (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) - (use-local-map sql-interactive-mode-map) (if sql-interactive-mode-menu (easy-menu-add sql-interactive-mode-menu)) ; XEmacs - (set-syntax-table sql-mode-syntax-table) ;; Note that making KEYWORDS-ONLY nil will cause havoc if you try ;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column @@ -4409,9 +4361,10 @@ you entered, right above the output it created. (add-hook 'comint-preoutput-filter-functions #'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) - (make-local-variable 'sql-input-ring-file-name) - ;; Run the mode hook (along with comint's hooks). - (run-mode-hooks 'sql-interactive-mode-hook) + (make-local-variable 'sql-input-ring-file-name)) + +(defun sql--adjust-interactive-setup () + "Finish the mode's setup after running the mode hook." ;; Set comint based on user overrides. (setq comint-prompt-regexp (if sql-prompt-cont-regexp @@ -4490,7 +4443,7 @@ is specified in the connection settings." (dolist (vv connect-set) (let ((var (car vv)) (val (cadr vv))) - (set-default var (eval val)))) + (set-default var (eval val)))) ;FIXME: Why `eval'? (setq-default sql-connection connection) ;; :sqli-login params variable @@ -4521,10 +4474,10 @@ is specified in the connection settings." (if vals (cons var vals) var))))) ;; Start the SQLi session with revised list of login parameters - (eval `(let ((,param-var ',rem-vars)) - (sql-product-interactive - ',sql-product - ',(or buf-name (format "<%s>" connection)))))) + (cl-progv (list param-var) (list rem-vars) + (sql-product-interactive + sql-product + (or buf-name (format "<%s>" connection))))) (user-error "SQL Connection <%s> does not exist" connection) nil))) @@ -4595,7 +4548,10 @@ optionally is saved to the user's init file." (format "Connection <%s>\t%s" (car conn) (let ((sql-user "") (sql-database "") (sql-server "") (sql-port 0)) - (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name))))) + (cl-progv + (mapcar #'car (cdr conn)) + (mapcar #'cadr (cdr conn)) + (sql-make-alternate-buffer-name)))) (list 'sql-connect (car conn)) t)) sql-connection-alist) @@ -4977,8 +4933,7 @@ The default comes from `process-coding-system-alist' and See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values." :version "24.1" - :type '(repeat string) - :group 'SQL) + :type '(repeat string)) (defun sql-oracle-completion-object (sqlbuf schema) (sql-redirect-value @@ -5624,21 +5579,18 @@ buffer. (defcustom sql-vertica-program "vsql" "Command to start the Vertica client." :version "25.1" - :type 'file - :group 'SQL) + :type 'file) (defcustom sql-vertica-options '("-P" "pager=off") "List of additional options for `sql-vertica-program'. The default value disables the internal pager." :version "25.1" - :type '(repeat string) - :group 'SQL) + :type '(repeat string)) (defcustom sql-vertica-login-params '(user password database server) "List of login parameters needed to connect to Vertica." :version "25.1" - :type 'sql-login-params - :group 'SQL) + :type 'sql-login-params) (defun sql-comint-vertica (product options &optional buf-name) "Create comint buffer and connect to Vertica." diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index f9b069fd4e5..0f2c9431f6e 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries." (when subword-mode (superword-mode -1)) (subword-setup-buffer)) +;; This is defined also in cc-cmds.el, but as obsolete since 24.3. +;; Let's keep this until the other one can also be removed. (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") ;;;###autoload diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 7ffa6d41dac..33aad2d39f7 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1346,9 +1346,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'." (not tcl-use-smart-word-finder) tcl-use-smart-word-finder)))) (completing-read - (if (or (null word) (string= word "")) - "Help on Tcl command: " - (format "Help on Tcl command (default %s): " word)) + (format-prompt "Help on Tcl command: " + (and (not (equal word "")) word)) tcl-help-alist nil t nil nil word))) current-prefix-arg)) (if (not (equal tcl-help-directory-list tcl-help-saved-dirs)) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 3c9ced02916..8bde89e774e 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1,4 +1,4 @@ -;;; vera-mode.el --- major mode for editing Vera files +;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2020 Free Software Foundation, Inc. @@ -33,9 +33,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This package provides a simple Emacs major mode for editing Vera code. ;; It includes the following features: @@ -44,38 +42,11 @@ ;; - Indentation ;; - Word/keyword completion ;; - Block commenting -;; - Works under GNU Emacs and XEmacs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Documentation ;; See comment string of function `vera-mode' or type `C-h m' in Emacs. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Installation - -;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X - -;; Put `vera-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 -;; following line in your Emacs start-up file (`.emacs'): - -;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) - -;; If you already have the compiled `vera-mode.elc' file, put it in the same -;; directory. Otherwise, byte-compile the source file: -;; Emacs: M-x byte-compile-file -> vera-mode.el -;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el - -;; 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'): - -;; (autoload 'vera-mode "vera-mode" "Vera Mode" t) -;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -90,16 +61,14 @@ (defcustom vera-basic-offset 2 "Amount of basic offset used for indentation." - :type 'integer - :group 'vera) + :type 'integer) (defcustom vera-underscore-is-part-of-word nil "Non-nil means consider the underscore character `_' as part of word. An identifier containing underscores is then treated as a single word in select and move operations. All parts of an identifier separated by underscore are treated as single words otherwise." - :type 'boolean - :group 'vera) + :type 'boolean) (make-obsolete-variable 'vera-underscore-is-part-of-word 'superword-mode "24.4") @@ -110,8 +79,7 @@ else if not at beginning of line then insert tab, else if last command was a `TAB' or `RET' then dedent one step, else indent current line. If nil, TAB always indents current line." - :type 'boolean - :group 'vera) + :type 'boolean) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -125,9 +93,6 @@ If nil, TAB always indents current line." (let ((map (make-sparse-keymap))) ;; Backspace/delete key bindings. (define-key map [backspace] 'backward-delete-char-untabify) - (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key map [delete] 'delete-char) - (define-key map [(meta delete)] 'kill-word)) ;; Standard key bindings. (define-key map "\M-e" 'vera-forward-statement) (define-key map "\M-a" 'vera-backward-statement) @@ -227,9 +192,7 @@ If nil, TAB always indents current line." (modify-syntax-entry ?\{ "(}" syntax-table) (modify-syntax-entry ?\} "){" syntax-table) ;; comment - (if (featurep 'xemacs) - (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs - (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs + (modify-syntax-entry ?\/ ". 124b" syntax-table) (modify-syntax-entry ?\* ". 23" syntax-table) ;; newline and CR (modify-syntax-entry ?\n "> b" syntax-table) @@ -314,8 +277,6 @@ Key bindings: ;; initialize font locking (set (make-local-variable 'font-lock-defaults) '(vera-font-lock-keywords nil nil ((?\_ . "w")))) - ;; add menu (XEmacs) - (easy-menu-add vera-mode-menu) ;; miscellaneous (message "Vera Mode %s. Type C-c C-h for documentation." vera-version)) @@ -542,12 +503,6 @@ Key bindings: ) "List of Vera-RVM predefined constants.") -;; `regexp-opt' undefined (`xemacs-devel' not installed) -(unless (fboundp 'regexp-opt) - (defun regexp-opt (strings &optional paren) - (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat 'regexp-quote strings "\\|") close)))) - (defconst vera-keywords-regexp (concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>") "Regexp for Vera keywords.") @@ -796,10 +751,7 @@ This function does not modify point or mark." (defun vera-skip-forward-literal () "Skip forward literal and return t if within one." - (let ((state (save-excursion - (if (fboundp 'syntax-ppss) - (syntax-ppss) - (parse-partial-sexp (point-min) (point)))))) + (let ((state (save-excursion (syntax-ppss)))) (when (nth 8 state) ;; Inside a string or comment. (goto-char (nth 8 state)) @@ -814,10 +766,7 @@ This function does not modify point or mark." (defun vera-skip-backward-literal () "Skip backward literal and return t if within one." - (let ((state (save-excursion - (if (fboundp 'syntax-ppss) - (syntax-ppss) - (parse-partial-sexp (point-min) (point)))))) + (let ((state (save-excursion (syntax-ppss)))) (when (nth 8 state) ;; Inside a string or comment. (goto-char (nth 8 state)) @@ -1232,6 +1181,8 @@ Calls `indent-region' for whole buffer." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; electrifications +(defvar hippie-expand-only-buffers) + (defun vera-electric-tab (&optional prefix) "Do what I mean (indent, expand, tab, change indent, etc..). If preceding character is part of a word or a paren then `hippie-expand', @@ -1243,7 +1194,7 @@ If `vera-intelligent-tab' is nil, always indent line." (interactive "*P") (if vera-intelligent-tab (progn - (cond ((and (not (featurep 'xemacs)) (use-region-p)) + (cond ((use-region-p) (vera-indent-region (region-beginning) (region-end) nil)) ((memq (char-syntax (preceding-char)) '(?w ?_)) (let ((case-fold-search t) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 460957b7161..5a469bb9677 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2019.12.17.268053413 +;; Version: 2020.06.27.014326051 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2019-12-17-ffa2ba5-vpo-GNU" +(defconst verilog-mode-version "2020-06-27-0da9923-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -605,7 +605,7 @@ are lineup only when \\[verilog-pretty-declarations] is typed." (function :tag "Other")) :group 'verilog-mode-indent ) (put 'verilog-auto-lineup 'safe-local-variable - '(lambda (x) (memq x '(nil all assignments declarations)))) + (lambda (x) (memq x '(nil all assignments declarations)))) (defcustom verilog-indent-level 3 "Indentation of Verilog statements with respect to containing block." @@ -958,8 +958,8 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.") ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t) ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t) ;; verilog-verilator - (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) - (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) + (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) + (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) ;; verilog-leda ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t) ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t) @@ -1118,7 +1118,7 @@ SystemVerilog designs." :type 'boolean :group 'verilog-mode-auto) (put 'verilog-auto-reset-widths 'safe-local-variable - '(lambda (x) (memq x '(nil t unbased)))) + (lambda (x) (memq x '(nil t unbased)))) (defcustom verilog-assignment-delay "" "Text used for delays in delayed assignments. Add a trailing space if set." @@ -1138,7 +1138,7 @@ line." (const :tag "Line up Assignment statements" single)) :group 'verilog-mode-auto) (put 'verilog-auto-arg-format 'safe-local-variable - '(lambda (x) (memq x '(packed single)))) + (lambda (x) (memq x '(packed single)))) (defcustom verilog-auto-arg-sort nil "Non-nil means AUTOARG signal names will be sorted, not in declaration order. @@ -1263,7 +1263,7 @@ otherwise no vectors if sizes match (like using nil)." :group 'verilog-mode-auto :type '(choice (const nil) (const t) (const unsigned))) (put 'verilog-auto-inst-vector 'safe-local-variable - '(lambda (x) (memq x '(nil t unsigned)))) + (lambda (x) (memq x '(nil t unsigned)))) (defcustom verilog-auto-inst-template-numbers nil "If true, when creating templated ports with AUTOINST, add a comment. @@ -1280,7 +1280,19 @@ won't merge conflict." :group 'verilog-mode-auto :type '(choice (const nil) (const t) (const lhs))) (put 'verilog-auto-inst-template-numbers 'safe-local-variable - '(lambda (x) (memq x '(nil t lhs)))) + (lambda (x) (memq x '(nil t lhs)))) + +(defcustom verilog-auto-inst-template-required nil + "If non-nil, when creating a port with AUTOINST, require a template. +Any port which does not have a template will be ommitted from the +instantiation. + +If nil, if a port is not templated it will be inserted to connect +to a net with the same name as the port." + :version "28.0" + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-inst-template-required 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-inst-column 40 "Indent-to column number for net name part of AUTOINST created pin." @@ -1418,7 +1430,7 @@ See also `verilog-case-fold'." :type 'hook) (defvar verilog-imenu-generic-expression - '((nil "^\\s-*\\(?:m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1) + '((nil "^\\s-*\\(?:connectmodule\\|m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1) ("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3) ("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1) ("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) @@ -2503,11 +2515,13 @@ find the errors." (eval-when-compile (verilog-regexp-words '( "begin" + "connectmodule" "else" "end" "endcase" "endclass" "endclocking" + "endconnectmodule" "endgroup" "endfunction" "endmodule" @@ -2550,6 +2564,7 @@ find the errors." "\\(sequence\\)\\|" ; 14 "\\(clocking\\)\\|" ; 15 "\\(property\\)\\|" ; 16 + "\\(connectmodule\\)\\|" ; 17 "\\)\\>\\)")) (defconst verilog-end-block-re (eval-when-compile @@ -2710,6 +2725,7 @@ find the errors." "endclass" "endclocking" "endconfig" + "endconnectmodule" "endfunction" "endgenerate" "endgroup" @@ -2728,7 +2744,7 @@ find the errors." (defconst verilog-declaration-opener (eval-when-compile (verilog-regexp-words - '("module" "begin" "task" "function")))) + '("connectmodule" "module" "begin" "task" "function")))) (defconst verilog-declaration-prefix-re (eval-when-compile @@ -2790,9 +2806,9 @@ find the errors." (defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro)) (defconst verilog-defun-re - (eval-when-compile (verilog-regexp-words '("macromodule" "module" "class" "program" "interface" "package" "primitive" "config")))) + (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config")))) (defconst verilog-end-defun-re - (eval-when-compile (verilog-regexp-words '("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) + (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) (defconst verilog-zero-indent-re (concat verilog-defun-re "\\|" verilog-end-defun-re)) (defconst verilog-inst-comment-re @@ -2824,7 +2840,7 @@ find the errors." "generate" "endgenerate" "initial" "interface" "endinterface" - "module" "macromodule" "endmodule" + "connectmodule" "module" "macromodule" "endconnectmodule" "endmodule" "package" "endpackage" "primitive" "endprimitive" "program" "endprogram" @@ -2892,14 +2908,14 @@ find the errors." (defconst verilog-defun-level-not-generate-re (eval-when-compile (verilog-regexp-words - '( "module" "macromodule" "primitive" "class" "program" + '( "connectmodule" "module" "macromodule" "primitive" "class" "program" "interface" "package" "config")))) (defconst verilog-defun-level-re (eval-when-compile (verilog-regexp-words (append - '( "module" "macromodule" "primitive" "class" "program" + '( "connectmodule" "module" "macromodule" "primitive" "class" "program" "interface" "package" "config") '( "initial" "final" "always" "always_comb" "always_ff" "always_latch" "endtask" "endfunction" ))))) @@ -2914,7 +2930,7 @@ find the errors." (eval-when-compile (verilog-regexp-words '( - "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" + "endconnectmodule" "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" )))) (defconst verilog-dpi-import-export-re @@ -2935,7 +2951,7 @@ find the errors." (eval-when-compile (verilog-regexp-words '( - "always" "assign" "always_latch" "always_ff" "always_comb" "constraint" + "always" "assign" "always_latch" "always_ff" "always_comb" "connectmodule" "constraint" "import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while" "if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert" )))) @@ -3053,6 +3069,8 @@ find the errors." "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ;; 1800-2012 "implements" "interconnect" "nettype" "soft" + ;; AMS + "connectmodule" "endconnectmodule" )) "List of Verilog keywords.") @@ -3117,7 +3135,7 @@ See also `verilog-font-lock-extra-types'.") (:foreground "DimGray" :italic t)) (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) - (t (:italis t))) + (t (:italic t))) "Font lock mode face used to background highlight translate-off regions." :group 'font-lock-highlighting-faces) @@ -3199,7 +3217,7 @@ See also `verilog-font-lock-extra-types'.") "atan2" "atanh" "branch" "ceil" "connect" "connectmodule" "connectrules" "continuous" "cos" "cosh" "ddt" "ddt_nature" "ddx" "discipline" "discrete" "domain" "driver_update" - "endconnectrules" "enddiscipline" "endnature" "endparamset" + "endconnectmodule" "endconnectrules" "enddiscipline" "endnature" "endparamset" "exclude" "exp" "final_step" "flicker_noise" "floor" "flow" "from" "ground" "hypot" "idt" "idt_nature" "idtmod" "inf" "initial_step" "laplace_nd" "laplace_np" "laplace_zd" @@ -3278,9 +3296,9 @@ See also `verilog-font-lock-extra-types'.") (list ;; Fontify module definitions (list - "\\<\\(\\(macro\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)" + "\\<\\(\\(macro\\|connect\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)" '(1 font-lock-keyword-face) - '(3 font-lock-function-name-face 'prepend)) + '(3 font-lock-function-name-face prepend)) ;; Fontify function definitions (list (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) @@ -3290,7 +3308,16 @@ See also `verilog-font-lock-extra-types'.") (1 font-lock-keyword-face) (2 font-lock-constant-face append)) '("\\<function\\>\\s-+\\(\\sw+\\)" - 1 'font-lock-constant-face append)))) + 1 'font-lock-constant-face append) + ;; Fontify variable names in declarations + (list ;; Implemented as an anchored-matcher + (concat verilog-declaration-re + " *\\(" verilog-range-re "\\)?") + (list ;; anchored-highlighter + (concat "\\_<\\(" verilog-symbol-re "\\)" + " *\\(" verilog-range-re "\\)?*") + nil nil '(1 font-lock-variable-name-face)))))) + (setq verilog-font-lock-keywords-2 (append verilog-font-lock-keywords-1 @@ -3596,7 +3623,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq found 't)))))) ((looking-at verilog-end-block-re) (verilog-leap-to-head)) - ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") + ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)\\|\\(\\<endconnectmodule\\>\\)") (cond ((match-end 1) (verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move)) @@ -3610,6 +3637,8 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-backward "\\<interface\\>" nil 'move)) ((match-end 6) (verilog-re-search-backward "\\<package\\>" nil 'move)) + ((match-end 7) + (verilog-re-search-backward "\\<connectmodule\\>" nil 'move)) (t (goto-char st) (backward-sexp 1)))) @@ -3735,7 +3764,8 @@ Use filename, if current buffer being edited shorten to just buffer name." "\\(\\<class\\>\\)\\|" "\\(\\<program\\>\\)\\|" "\\(\\<interface\\>\\)\\|" - "\\(\\<package\\>\\)")) + "\\(\\<package\\>\\)\\|" + "\\(\\<connectmodule\\>\\)")) (cond ((match-end 1) (verilog-re-search-forward "\\<endmodule\\>" nil 'move)) @@ -3749,6 +3779,8 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-forward "\\<endinterface\\>" nil 'move)) ((match-end 6) (verilog-re-search-forward "\\<endpackage\\>" nil 'move)) + ((match-end 7) + (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move)) (t (goto-char st) (if (= (following-char) ?\) ) @@ -4556,13 +4588,13 @@ More specifically, point @ in the line foo : @ begin" (let ((nest 1)) (while t (verilog-re-search-backward - (concat "\\(\\<module\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|" + (concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|" "\\(\\<endcase\\>\\)\\>") nil 'move) (cond - ((match-end 3) + ((match-end 4) (setq nest (1+ nest))) - ((match-end 2) + ((match-end 3) (if (= nest 1) (throw 'found 1)) (setq nest (1- nest))) @@ -4571,9 +4603,11 @@ More specifically, point @ in the line foo : @ begin" nil))) (defun verilog-backward-up-list (arg) - "Call `backward-up-list' ARG, ignoring comments." + "Call `backward-up-list' ARG, ignoring comments and errors." (let ((parse-sexp-ignore-comments t)) - (backward-up-list arg))) + (condition-case nil + (backward-up-list arg) ;; May throw Unbalanced parenthesis + (error nil)))) (defun verilog-forward-sexp-cmt (arg) "Call `forward-sexp' ARG, inside comments." @@ -4595,13 +4629,15 @@ More specifically, after a generate and before an endgenerate." (while (and (/= nest 0) (verilog-re-search-backward - "\\<\\(module\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move) + "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move) (cond ((match-end 1) ; module - we have crawled out (throw 'done 1)) - ((match-end 2) ; generate + ((match-end 2) ; connectmodule - we have crawled out + (throw 'done 1)) + ((match-end 3) ; generate (setq nest (1- nest))) - ((match-end 3) ; endgenerate + ((match-end 4) ; endgenerate (setq nest (1+ nest)))))))) (= nest 0) )) ; return nest @@ -5064,6 +5100,8 @@ primitive or interface named NAME." (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) ((match-end 16) ; of verilog-end-block-ordered-re (setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>")) + ((match-end 17) ; of verilog-end-block-ordered-re + (setq reg "\\(\\<connectmodule\\>\\)\\|\\<endconnectmodule\\>")) (t (error "Problem in verilog-set-auto-endcomments"))) (let (b e) @@ -5089,7 +5127,7 @@ primitive or interface named NAME." (setq string (buffer-substring b e))) (t (ding 't) - (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)"))))) + (setq string "unmatched end(function|task|module|connectmodule|primitive|interface|package|class|clocking)"))))) (end-of-line) (insert (concat " // " string ))) )))))))))) @@ -5345,7 +5383,7 @@ becomes: (interactive) (save-excursion (beginning-of-line) - (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$") + (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\).*$") (replace-match (format ;; %3s makes numbers 1-999 line up nicely "\\1//Verilint %3s off // WARNING: \\3" @@ -5560,7 +5598,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (case-fold-search nil) (par 0) (begin (looking-at "[ \t]*begin\\>")) - (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t))) + (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)" nil t))) (structres nil) (type (catch 'nesting ;; Keep working backwards until we can figure out @@ -6788,7 +6826,7 @@ Do not count named blocks or case-statements." ((looking-at verilog-named-block-re) (current-column)) ((and (not (looking-at verilog-extended-case-re)) - (looking-at "^[^:;]+[ \t]*:")) + (looking-at "^[^:;]+:")) (verilog-re-search-forward ":" nil t) (skip-chars-forward " \t") (current-column)) @@ -7113,7 +7151,7 @@ BASEIND is the base indent to offset everything." (let ((pos (point-marker)) (lim (save-excursion ;; (verilog-re-search-backward verilog-declaration-opener nil 'move) - (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)\\|\\(\\<task\\>\\)" nil 'move) + (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)\\|\\(\\<task\\>\\)" nil 'move) (point))) (ind) (val) @@ -7272,7 +7310,7 @@ it displays a list of all possible completions.") \(integer, real, reg...)") (defvar verilog-cpp-keywords - '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else" + '("connectmodule" "module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else" "endif") "Keywords to complete when at first word of a line in declarative scope. \(initial, always, begin, assign...) @@ -7283,7 +7321,7 @@ will be completed at runtime and should not be added to this list.") (append '( "always" "always_comb" "always_ff" "always_latch" "assign" - "begin" "end" "generate" "endgenerate" "module" "endmodule" + "begin" "end" "connectmodule" "endconnectmodule" "generate" "endgenerate" "module" "endmodule" "specify" "endspecify" "function" "endfunction" "initial" "final" "task" "endtask" "primitive" "endprimitive" ) @@ -7380,9 +7418,9 @@ TYPE is `module', `tf' for task or function, or t if unknown." (if (string= verilog-str "") (setq verilog-str "[a-zA-Z_]")) (let ((verilog-str (concat (cond - ((eq type 'module) "\\<\\(module\\)\\s +") + ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") - (t "\\<\\(task\\|function\\|module\\)\\s +")) + (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) match) @@ -7724,7 +7762,7 @@ If search fails, other files are checked based on (first 1) (prevpos (point-min)) (final-context-start (make-marker)) - (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) + (regexp "\\(\\(connect\\)?module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) (with-output-to-temp-buffer "*Occur*" (save-excursion (message "Searching for %s ..." regexp) @@ -7782,7 +7820,7 @@ If search fails, other files are checked based on "Return point if within translate-off region, else nil." (and (save-excursion (re-search-backward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>") + (concat "//.*" verilog-directive-regexp "\\(on\\|off\\)\\>") nil t)) (equal "off" (match-string 2)) (point))) @@ -7790,14 +7828,14 @@ If search fails, other files are checked based on (defun verilog-start-translate-off (limit) "Return point before translate-off directive if before LIMIT, else nil." (when (re-search-forward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>") + (concat "//.*" verilog-directive-regexp "off\\>") limit t) (match-beginning 0))) (defun verilog-back-to-start-translate-off (limit) "Return point before translate-off directive if before LIMIT, else nil." (when (re-search-backward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>") + (concat "//.*" verilog-directive-regexp "off\\>") limit t) (match-beginning 0))) @@ -7805,7 +7843,7 @@ If search fails, other files are checked based on "Return point after translate-on directive if before LIMIT, else nil." (re-search-forward (concat - "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t)) + "//.*" verilog-directive-regexp "on\\>") limit t)) (defun verilog-match-translate-off (limit) "Match a translate-off block, setting `match-data' and returning t, else nil. @@ -8445,7 +8483,8 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." (let ((olist)) (save-excursion ;; /*AUTOPUNT("parameter", "parameter")*/ - (backward-sexp 1) + (when (not (eq (char-before) ?\*)) ; Not .* + (backward-sexp 1)) (while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?") (setq olist (cons (match-string-no-properties 1) olist)) (goto-char (match-end 0)))) @@ -9895,7 +9934,7 @@ Allows version control to check out the file if need be." (while (and ;; It may be tempting to look for verilog-defun-re, ;; don't, it slows things down a lot! - (verilog-re-search-forward-quick "\\<\\(module\\|interface\\|program\\)\\>" nil t) + (verilog-re-search-forward-quick "\\<\\(connectmodule\\|module\\|interface\\|program\\)\\>" nil t) (setq type (match-string-no-properties 0)) (verilog-re-search-forward-quick "[(;]" nil t)) (if (equal module (verilog-read-module-name)) @@ -9982,7 +10021,7 @@ Or, just the existing dirnames themselves if there are no wildcards." (while dirnames (setq dirname (car dirnames) dirnames (cdr dirnames)) - (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root + (cond ((string-match (concat "^\\(\\|[^*?]*[/\\]\\)" ; root "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? "\\(.*\\)") ; rest dirname) @@ -10923,9 +10962,9 @@ shown) will make this into: ;; Presume one module per file. (save-excursion (goto-char (point-min)) - (while (verilog-re-search-forward-quick "\\<module\\>" nil t) + (while (verilog-re-search-forward-quick "\\<\\(connect\\)?module\\>" nil t) (let ((endmodp (save-excursion - (verilog-re-search-forward-quick "\\<endmodule\\>" nil t) + (verilog-re-search-forward-quick "\\<end\\(connect\\)?module\\>" nil t) (point)))) ;; See if there's already a comment .. inside a comment so not verilog-re-search (when (not (re-search-forward "/\\*AUTOARG\\*/" endmodp t)) @@ -11370,9 +11409,10 @@ See the example in `verilog-auto-inout-modport'." (defvar vl-bits nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning -(defun verilog-auto-inst-port (port-st indent-pt moddecls tpl-list tpl-num for-star par-values) +(defun verilog-auto-inst-port (section port-st indent-pt moddecls tpl-list tpl-num + for-star par-values) "Print out an instantiation connection for this PORT-ST. -Insert to INDENT-PT, use template TPL-LIST. +Inside SECTION, insert to INDENT-PT, use template TPL-LIST. @ are instantiation numbers, replaced with TPL-NUM. @\"(expression @)\" are evaluated, with @ as a variable. If FOR-STAR add comment it is a .* expansion. @@ -11474,60 +11514,74 @@ If PAR-VALUES replace final strings with these parameter values." (setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net)) (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) ;; Insert it - (indent-to indent-pt) - (insert "." port) - (unless (and verilog-auto-inst-dot-name - (equal port tpl-net)) - (indent-to verilog-auto-inst-column) - (insert "(" tpl-net ")")) - (insert ",") - (cond (tpl-ass - (verilog-read-auto-template-hit tpl-ass) - (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) - verilog-auto-inst-column)) - ;; verilog-insert requires the complete comment in one call - including the newline - (cond ((equal verilog-auto-inst-template-numbers 'lhs) - (verilog-insert " // Templated" - " LHS: " (nth 0 tpl-ass) - "\n")) - (verilog-auto-inst-template-numbers - (verilog-insert " // Templated" - " T" (int-to-string (nth 2 tpl-ass)) - " L" (int-to-string (nth 3 tpl-ass)) - "\n")) - (t - (verilog-insert " // Templated\n")))) - (for-star - (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) - verilog-auto-inst-column)) - (verilog-insert " // Implicit .*\n")) - (t - (insert "\n"))))) -;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3") + (when (or tpl-ass (not verilog-auto-inst-template-required)) + (verilog-auto-inst-first section) + (indent-to indent-pt) + (insert "." port) + (unless (and verilog-auto-inst-dot-name + (equal port tpl-net)) + (indent-to verilog-auto-inst-column) + (insert "(" tpl-net ")")) + (insert ",") + (cond (tpl-ass + (verilog-read-auto-template-hit tpl-ass) + (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) + verilog-auto-inst-column)) + ;; verilog-insert requires the complete comment in one call - including the newline + (cond ((equal verilog-auto-inst-template-numbers 'lhs) + (verilog-insert " // Templated" + " LHS: " (nth 0 tpl-ass) + "\n")) + (verilog-auto-inst-template-numbers + (verilog-insert " // Templated" + " T" (int-to-string (nth 2 tpl-ass)) + " L" (int-to-string (nth 3 tpl-ass)) + "\n")) + (t + (verilog-insert " // Templated\n")))) + (for-star + (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) + verilog-auto-inst-column)) + (verilog-insert " // Implicit .*\n")) + (t + (insert "\n")))))) +;;(verilog-auto-inst-port "" (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3") ;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]") ;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));") -(defun verilog-auto-inst-port-list (sig-list indent-pt moddecls tpl-list tpl-num for-star par-values) - "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'." - (when verilog-auto-inst-sort - (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare))) - (mapc (lambda (port) - (verilog-auto-inst-port port indent-pt moddecls - tpl-list tpl-num for-star par-values)) - sig-list)) +(defvar verilog-auto-inst-first-section nil + "Local first-in-section for `verilog-auto-inst-first'.") +(defvar verilog-auto-inst-first-any nil + "Local first-in-any-section for `verilog-auto-inst-first'.") -(defun verilog-auto-inst-first () - "Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]." +(defun verilog-auto-inst-first (section) + "Insert , and SECTION before port, as part of \\[verilog-auto-inst]." ;; Do we need a trailing comma? ;; There maybe an ifdef or something similar before us. What a mess. Thus ;; to avoid trouble we only insert on preceding ) or *. ;; Insert first port on new line - (insert "\n") ; Must insert before search, so point will move forward if insert comma - (save-excursion - (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil) - (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure - (forward-char 1) - (insert ",")))) + (when verilog-auto-inst-first-any + (setq verilog-auto-inst-first-any nil) + (insert "\n") ; Must insert before search, so point will move forward if insert comma + (save-excursion + (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil) + (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure + (forward-char 1) + (insert ",")))) + (when verilog-auto-inst-first-section + (setq verilog-auto-inst-first-section nil) + (verilog-insert-indent section))) + +(defun verilog-auto-inst-port-list (section sig-list indent-pt moddecls + tpl-list tpl-num for-star par-values) + "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'." + (when verilog-auto-inst-sort + (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare))) + (let ((verilog-auto-inst-first-section t)) + (mapc (lambda (port) + (verilog-auto-inst-port section port indent-pt moddecls + tpl-list tpl-num for-star par-values)) + sig-list))) (defun verilog-auto-star () "Expand SystemVerilog .* pins, as part of \\[verilog-auto]. @@ -11554,6 +11608,9 @@ Replace the pin connections to an instantiation or interface declaration with ones automatically derived from the module or interface header of the instantiated item. +You may also provide an optional regular expression, in which +case only I/O matching the regular expression will be included. + If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports, and delete them before saving unless `verilog-auto-star-save' is set. See `verilog-auto-star' for more information. @@ -11697,6 +11754,10 @@ Templates: debugging is completed though, it will result in lots of extra differences and merge conflicts. + If a connection name does not match any template, it is + connected to a net by the same name as the port (unless + `verilog-auto-inst-template-required' is true). + Setting `verilog-auto-template-warn-unused' will report errors if any template lines are unused. @@ -11868,16 +11929,19 @@ For more information see the \\[verilog-faq] and forums at URL `https://www.veripool.org'." (save-excursion ;; Find beginning - (let* ((pt (point)) + (let* ((params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) + (pt (point)) (for-star (save-excursion (backward-char 2) (looking-at "\\.\\*"))) (indent-pt (save-excursion (verilog-backward-open-paren) (1+ (current-column)))) (verilog-auto-inst-column (max verilog-auto-inst-column (+ 16 (* 8 (/ (+ indent-pt 7) 8))))) + (verilog-auto-inst-first-any t) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) submod submodi submoddecls - inst skip-pins tpl-list tpl-num did-first par-values) + inst skip-pins tpl-list tpl-num par-values) ;; Find module name that is instantiated (setq submod (verilog-read-inst-module) @@ -11912,53 +11976,58 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-vars submoddecls) skip-pins))) (vl-dir "interfaced")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when (and sig-list verilog-auto-inst-interfaced-ports) - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) ;; Note these are searched for in verilog-read-sub-decls. - (verilog-insert-indent "// Interfaced\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls + (verilog-auto-inst-port-list "// Interfaced\n" + sig-list indent-pt moddecls tpl-list tpl-num for-star par-values))) (let ((sig-list (verilog-signals-not-in (verilog-decls-get-interfaces submoddecls) skip-pins)) (vl-dir "interface")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) ;; Note these are searched for in verilog-read-sub-decls. - (verilog-insert-indent "// Interfaces\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls - tpl-list tpl-num for-star par-values))) + (verilog-auto-inst-port-list "// Interfaces\n" + sig-list indent-pt moddecls + tpl-list tpl-num for-star par-values))) (let ((sig-list (verilog-signals-not-in (verilog-decls-get-outputs submoddecls) skip-pins)) (vl-dir "output")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (verilog-insert-indent "// Outputs\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls + (verilog-auto-inst-port-list "// Outputs\n" + sig-list indent-pt moddecls tpl-list tpl-num for-star par-values))) (let ((sig-list (verilog-signals-not-in (verilog-decls-get-inouts submoddecls) skip-pins)) (vl-dir "inout")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (verilog-insert-indent "// Inouts\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls + (verilog-auto-inst-port-list "// Inouts\n" + sig-list indent-pt moddecls tpl-list tpl-num for-star par-values))) (let ((sig-list (verilog-signals-not-in (verilog-decls-get-inputs submoddecls) skip-pins)) (vl-dir "input")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (verilog-insert-indent "// Inputs\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls + (verilog-auto-inst-port-list "// Inputs\n" + sig-list indent-pt moddecls tpl-list tpl-num for-star par-values))) ;; Kill extra semi (save-excursion - (cond (did-first + (cond ((not verilog-auto-inst-first-any) (re-search-backward "," pt t) (delete-char 1) (insert ");") @@ -12020,10 +12089,11 @@ Templates: (1+ (current-column)))) (verilog-auto-inst-column (max verilog-auto-inst-column (+ 16 (* 8 (/ (+ indent-pt 7) 8))))) + (verilog-auto-inst-first-any t) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) submod submodi submoddecls - inst skip-pins tpl-list tpl-num did-first) + inst skip-pins tpl-list tpl-num) ;; Find module name that is instantiated (setq submod (save-excursion ;; Get to the point where AUTOINST normally is to read the module @@ -12060,14 +12130,13 @@ Templates: (when regexp (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list - (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) ;; Note these are searched for in verilog-read-sub-decls. - (verilog-insert-indent "// Parameters\n") - (verilog-auto-inst-port-list sig-list indent-pt moddecls + (verilog-auto-inst-port-list "// Parameters\n" + sig-list indent-pt moddecls tpl-list tpl-num nil nil))) ;; Kill extra semi (save-excursion - (cond (did-first + (cond ((not verilog-auto-inst-first-any) (re-search-backward "," pt t) (delete-char 1) (insert ")") diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 39819131010..3d66483b83e 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -2304,10 +2304,6 @@ Ignore byte-compiler warnings you might see." (defvaralias 'vhdl-last-input-event 'last-input-char) (defvaralias 'vhdl-last-input-event 'last-input-event)) -;; `help-print-return-message' changed to `print-help-return-message' in Emacs -;;;(unless (fboundp 'help-print-return-message) -;;; (defalias 'help-print-return-message 'print-help-return-message)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Compatibility with older VHDL Mode versions @@ -16148,7 +16144,7 @@ expansion function)." ;; initialize speedbar (if (not (boundp 'speedbar-frame)) - (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))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 1cee552b0c0..266f40abbae 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -186,7 +186,7 @@ and you want to simplify them for the mode line "Non-nil means display current function name in mode line. This makes a difference only if `which-function-mode' is non-nil.") -(add-hook 'find-file-hook 'which-func-ff-hook t) +(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t) (defun which-func-try-to-enable () (unless (or (not which-function-mode) @@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is non-nil.") (member major-mode which-func-modes))))) (defun which-func-ff-hook () - "File find hook for Which Function mode. + "`after-change-major-mode-hook' for Which Function mode. It creates the Imenu index for the buffer, if necessary." (which-func-try-to-enable) @@ -282,52 +282,55 @@ If no function name is found, return nil." (when (null name) (setq name (add-log-current-defun))) ;; If Imenu is loaded, try to make an index alist with it. + ;; If `add-log-current-defun' ran and gave nil, accept that. (when (and (null name) - (boundp 'imenu--index-alist) - (or (null imenu--index-alist) - ;; Update if outdated - (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) - (null which-function-imenu-failed)) - (ignore-errors (imenu--make-index-alist t)) - (unless imenu--index-alist - (set (make-local-variable 'which-function-imenu-failed) t))) - ;; If we have an index alist, use it. - (when (and (null name) - (boundp 'imenu--index-alist) imenu--index-alist) - (let ((alist imenu--index-alist) - (minoffset (point-max)) - offset pair mark imstack namestack) - ;; Elements of alist are either ("name" . marker), or - ;; ("submenu" ("name" . marker) ... ). The list can be - ;; arbitrarily nested. - (while (or alist imstack) - (if (null alist) - (setq alist (car imstack) - namestack (cdr namestack) - imstack (cdr imstack)) - - (setq pair (car-safe alist) - alist (cdr-safe alist)) - - (cond - ((atom pair)) ; Skip anything not a cons. - - ((imenu--subalist-p pair) - (setq imstack (cons alist imstack) - namestack (cons (car pair) namestack) - alist (cdr pair))) - - ((or (number-or-marker-p (setq mark (cdr pair))) - (and (overlayp mark) - (setq mark (overlay-start mark)))) - (when (and (>= (setq offset (- (point) mark)) 0) - (< offset minoffset)) ; Find the closest item. - (setq minoffset offset - name (if (null which-func-imenu-joiner-function) - (car pair) - (funcall - which-func-imenu-joiner-function - (reverse (cons (car pair) namestack)))))))))))) + (null add-log-current-defun-function)) + (when (and (null name) + (boundp 'imenu--index-alist) + (or (null imenu--index-alist) + ;; Update if outdated + (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) + (null which-function-imenu-failed)) + (ignore-errors (imenu--make-index-alist t)) + (unless imenu--index-alist + (set (make-local-variable 'which-function-imenu-failed) t))) + ;; If we have an index alist, use it. + (when (and (null name) + (boundp 'imenu--index-alist) imenu--index-alist) + (let ((alist imenu--index-alist) + (minoffset (point-max)) + offset pair mark imstack namestack) + ;; Elements of alist are either ("name" . marker), or + ;; ("submenu" ("name" . marker) ... ). The list can be + ;; arbitrarily nested. + (while (or alist imstack) + (if (null alist) + (setq alist (car imstack) + namestack (cdr namestack) + imstack (cdr imstack)) + + (setq pair (car-safe alist) + alist (cdr-safe alist)) + + (cond + ((atom pair)) ; Skip anything not a cons. + + ((imenu--subalist-p pair) + (setq imstack (cons alist imstack) + namestack (cons (car pair) namestack) + alist (cdr pair))) + + ((or (number-or-marker-p (setq mark (cdr pair))) + (and (overlayp mark) + (setq mark (overlay-start mark)))) + (when (and (>= (setq offset (- (point) mark)) 0) + (< offset minoffset)) ; Find the closest item. + (setq minoffset offset + name (if (null which-func-imenu-joiner-function) + (car pair) + (funcall + which-func-imenu-joiner-function + (reverse (cons (car pair) namestack))))))))))))) ;; Filter the name if requested. (when name (if which-func-cleanup-function diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index c36a9bd9940..de2053c3c99 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,6 +1,11 @@ -;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- +;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;; Version: 1.0.3 +;; Package-Requires: ((emacs "26.3")) + +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. @@ -258,17 +263,24 @@ be found, return nil. The default implementation uses `semantic-symref-tool-alist' to find a search tool; by default, this uses \"find | grep\" in the -`project-current' roots." - (cl-mapcan +current project's main and external roots." + (mapcan (lambda (dir) (xref-references-in-directory identifier dir)) (let ((pr (project-current t))) - (append - (project-roots pr) + (cons + (if (fboundp 'project-root) + (project-root pr) + (with-no-warnings + (project-roots pr))) (project-external-roots pr))))) (cl-defgeneric xref-backend-apropos (backend pattern) - "Find all symbols that match regexp PATTERN.") + "Find all symbols that match PATTERN string. +The second argument has the same meaning as in `apropos'. + +If BACKEND is implemented in Lisp, it can use +`xref-apropos-regexp' to convert the pattern to regexp.") (cl-defgeneric xref-backend-identifier-at-point (_backend) "Return the relevant identifier at point. @@ -596,7 +608,10 @@ buffer." (user-error "No reference at point"))) (xref--current-item xref)) (xref--show-location (xref-item-location xref) (if quit 'quit t)) - (next-error-found buffer (current-buffer)))) + (if (fboundp 'next-error-found) + (next-error-found buffer (current-buffer)) + ;; Emacs < 27 + (setq next-error-last-buffer buffer)))) (defun xref-quit-and-goto-xref () "Quit *xref* buffer, then jump to xref on current line." @@ -946,8 +961,18 @@ Accepts the same arguments as `xref-show-xrefs-function'." (defvar xref--read-pattern-history nil) -(defun xref--show-xrefs (fetcher display-action) +(defun xref--show-xrefs (fetcher display-action &optional _always-show-list) (xref--push-markers) + (unless (functionp fetcher) + ;; Old convention. + (let ((xrefs fetcher)) + (setq fetcher + (lambda () + (if (eq xrefs 'called-already) + (user-error "Refresh is not supported") + (prog1 + xrefs + (setq xrefs 'called-already))))))) (funcall xref-show-xrefs-function fetcher `((window . ,(selected-window)) (display-action . ,display-action)))) @@ -1093,14 +1118,24 @@ The argument has the same meaning as in `apropos'." "Search for pattern (word list or regexp): " nil 'xref--read-pattern-history))) (require 'apropos) - (xref--find-xrefs pattern 'apropos - (apropos-parse-pattern - (if (string-equal (regexp-quote pattern) pattern) - ;; Split into words - (or (split-string pattern "[ \t]+" t) - (user-error "No word list given")) - pattern)) - nil)) + (let* ((newpat + (if (and (version< emacs-version "28.0.50") + (memq (xref-find-backend) '(elisp etags))) + ;; Handle backends in older Emacs. + (xref-apropos-regexp pattern) + ;; Delegate pattern handling to the backend fully. + ;; The old way didn't work for "external" backends. + pattern))) + (xref--find-xrefs pattern 'apropos newpat nil))) + +(defun xref-apropos-regexp (pattern) + "Return an Emacs regexp from PATTERN similar to `apropos'." + (apropos-parse-pattern + (if (string-equal (regexp-quote pattern) pattern) + ;; Split into words + (or (split-string pattern "[ \t]+" t) + (user-error "No word list given")) + pattern))) ;;; Key bindings @@ -1262,13 +1297,13 @@ FILES must be a list of absolute file names." (insert (mapconcat #'identity files "\0")) (setq default-directory dir) (setq status - (project--process-file-region (point-min) - (point-max) - shell-file-name - output - nil - shell-command-switch - command))) + (xref--process-file-region (point-min) + (point-max) + shell-file-name + output + nil + shell-command-switch + command))) (goto-char (point-min)) (when (and (/= (point-min) (point-max)) (not (looking-at grep-re)) @@ -1283,6 +1318,24 @@ FILES must be a list of absolute file names." hits))) (xref--convert-hits (nreverse hits) regexp))) +(defun xref--process-file-region ( start end program + &optional buffer display + &rest args) + ;; FIXME: This branching shouldn't be necessary, but + ;; call-process-region *is* measurably faster, even for a program + ;; doing some actual work (for a period of time). Even though + ;; call-process-region also creates a temp file internally + ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + (if (not (file-remote-p default-directory)) + (apply #'call-process-region + start end program nil buffer display args) + (let ((infile (make-temp-file "ppfr"))) + (unwind-protect + (progn + (write-region start end infile nil 'silent) + (apply #'process-file program infile buffer display args)) + (delete-file infile))))) + (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' (defvar grep-find-template) @@ -1317,11 +1370,11 @@ directory, used as the root of the ignore globs." (lambda (ignore) (when (string-match-p "/\\'" ignore) (setq ignore (concat ignore "*"))) - (if (string-match "\\`\\./" ignore) - (setq ignore (replace-match dir t t ignore)) - (unless (string-prefix-p "*" ignore) - (setq ignore (concat "*/" ignore)))) - (shell-quote-argument ignore)) + (shell-quote-argument (if (string-match "\\`\\./" ignore) + (replace-match dir t t ignore) + (if (string-prefix-p "*" ignore) + ignore + (concat "*/" ignore))))) ignores " -o -path ") " " @@ -1364,8 +1417,8 @@ Such as the current syntax table and the applied syntax properties." (let (xref--last-file-buffer (tmp-buffer (generate-new-buffer " *xref-temp*"))) (unwind-protect - (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer)) - hits) + (mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer)) + hits) (kill-buffer tmp-buffer)))) (defun xref--collect-matches (hit regexp tmp-buffer) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 8dfb3a40dd1..c6997862f7f 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -446,8 +446,6 @@ Entry to this mode runs `scheme-mode-hook' and then (scheme-interaction-mode-initialize) (scheme-interaction-mode t))))) -(define-obsolete-function-alias 'advertised-xscheme-send-previous-expression - 'xscheme-send-previous-expression "23.2") ;;;; Debugger Mode |