diff options
Diffstat (limited to 'lisp/progmodes')
33 files changed, 1048 insertions, 1437 deletions
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d7b12db2211..d7092a37d44 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -269,9 +269,9 @@ via the internet it might also be http.") ;; pull/17 page if 17 is a PR. Explicit user/project#17 links to ;; possibly different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql github)) protocol) + (host-domain (_forge-type (eql 'github)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -285,9 +285,9 @@ via the internet it might also be http.") ;; namespace/project#18 or namespace/project!17 references to possibly ;; different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitlab)) protocol) + (host-domain (_forge-type (eql 'gitlab)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -302,9 +302,9 @@ via the internet it might also be http.") ;; Gitea: The systematics is exactly as for Github projects. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitea)) protocol) + (host-domain (_forge-type (eql 'gitea)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -323,7 +323,7 @@ via the internet it might also be http.") ;; repo without tracker, or a repo with a tracker using a different ;; name, etc. So we can only try to make a good guess. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql sourcehut)) protocol) + (host-domain (_forge-type (eql 'sourcehut)) protocol) `(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain) "[/:]\\(~[.A-Za-z0-9_/-]+\\)") "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index a9a52636b78..50249728048 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1896,16 +1896,18 @@ defun." (if (< arg 0) (c-while-widening-to-decl-block (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0))) - ;; Move forward to the next opening brace.... - (when (and (= arg 0) - (progn - (c-while-widening-to-decl-block - (not (c-syntactic-re-search-forward "{" nil 'eob))) - (eq (char-before) ?{))) - (backward-char) - ;; ... and backward to the function header. - (c-beginning-of-decl-1) - t)) + (prog1 + ;; Move forward to the next opening brace.... + (when (and (= arg 0) + (progn + (c-while-widening-to-decl-block + (not (c-syntactic-re-search-forward "{" nil 'eob))) + (eq (char-before) ?{))) + (backward-char) + ;; ... and backward to the function header. + (c-beginning-of-decl-1) + t) + (c-keep-region-active))) ;; Move backward to the opening brace of a function, making successively ;; larger portions of the buffer visible as necessary. @@ -3413,7 +3415,8 @@ to call `c-scan-conditionals' directly instead." (interactive "p") (let ((new-point (c-scan-conditionals count target-depth with-else))) (push-mark) - (goto-char new-point))) + (goto-char new-point)) + (c-keep-region-active)) (defun c-scan-conditionals (count &optional target-depth with-else) "Scan forward across COUNT preprocessor conditionals. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index db1f46621da..d37a50997ad 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -165,12 +165,16 @@ (defvar c-doc-line-join-end-ch) (defvar c-syntactic-context) (defvar c-syntactic-element) +(defvar c-new-id-start) +(defvar c-new-id-end) +(defvar c-new-id-is-type) (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) (cc-bytecomp-defun c-remove-string-fences) +(cc-bytecomp-defun c-fontify-new-found-type) ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -6808,26 +6812,47 @@ comment at the start of cc-engine.el for more info." (defvar c-found-types nil) (make-variable-buffer-local 'c-found-types) +;; Dynamically bound variable that instructs `c-forward-type' to +;; record the ranges of types that only are found. Behaves otherwise +;; like `c-record-type-identifiers'. Also when this variable is non-nil, +;; `c-fontify-new-found-type' doesn't get called (yet) for the purported +;; type. +(defvar c-record-found-types nil) + (defsubst c-clear-found-types () ;; Clears `c-found-types'. (setq c-found-types (make-hash-table :test #'equal :weakness nil))) -(defun c-add-type (from to) - ;; Add the given region as a type in `c-found-types'. If the region - ;; doesn't match an existing type but there is a type which is equal - ;; to the given one except that the last character is missing, then - ;; the shorter type is removed. That's done to avoid adding all - ;; prefixes of a type as it's being entered and font locked. This - ;; doesn't cover cases like when characters are removed from a type - ;; or added in the middle. We'd need the position of point when the - ;; font locking is invoked to solve this well. +(defun c-add-type-1 (from to) + ;; Add the given region as a type in `c-found-types'. Prepare occurrences + ;; of this new type for fontification throughout the buffer. ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) - (remhash (substring type 0 -1) c-found-types) - (puthash type t c-found-types)))) + (puthash type t c-found-types) + (when (and (not c-record-found-types) ; Only call `c-fontify-new-fount-type' + ; when we haven't "bound" c-found-types + ; to itself in c-forward-<>-arglist. + (eq (string-match c-symbol-key type) 0) + (eq (match-end 0) (length type))) + (c-fontify-new-found-type type))))) + +(defun c-add-type (from to) + ;; Add the given region as a type in `c-found-types'. Also perform the + ;; actions of `c-add-type-1'. If the region is or overlaps an identifier + ;; which might be being typed in, don't record it. This is tested by + ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid + ;; adding all prefixes of a type as it's being entered and font locked. + ;; This is a bit rough and ready, but now covers adding characters into the + ;; middle of an identifer. + ;; + ;; This function might do hidden buffer changes. + (if (and c-new-id-start c-new-id-end + (<= from c-new-id-end) (>= to c-new-id-start)) + (setq c-new-id-is-type t) + (c-add-type-1 from to))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. @@ -8210,11 +8235,6 @@ multi-line strings (but not C++, for example)." (setq c-record-ref-identifiers (cons range c-record-ref-identifiers)))))) -;; Dynamically bound variable that instructs `c-forward-type' to -;; record the ranges of types that only are found. Behaves otherwise -;; like `c-record-type-identifiers'. -(defvar c-record-found-types nil) - (defmacro c-forward-keyword-prefixed-id (type) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a type (if TYPE is 'type) or a name (otherwise) which @@ -8444,6 +8464,11 @@ multi-line strings (but not C++, for example)." (c-forward-<>-arglist-recur all-types))) (progn (when (consp c-record-found-types) + (let ((cur c-record-found-types)) + (while (consp (car-safe cur)) + (c-fontify-new-found-type + (buffer-substring-no-properties (caar cur) (cdar cur))) + (setq cur (cdr cur)))) (setq c-record-type-identifiers ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. @@ -9169,6 +9194,12 @@ multi-line strings (but not C++, for example)." (when (and (eq res t) (consp c-record-found-types)) + ;; Cause the confirmed types to get fontified. + (let ((cur c-record-found-types)) + (while (consp (car-safe cur)) + (c-fontify-new-found-type + (buffer-substring-no-properties (caar cur) (cdar cur))) + (setq cur (cdr cur)))) ;; Merge in the ranges of any types found by the second ;; `c-forward-type'. (setq c-record-type-identifiers @@ -12092,7 +12123,10 @@ comment at the start of cc-engine.el for more info." (and (c-major-mode-is 'pike-mode) c-decl-block-key))) (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) + (cond ((or (eq (char-after) ?\;) + (save-excursion + (progn (c-backward-syntactic-ws) + (c-at-vsemi-p)))) (setq braceassignp nil)) ((and class-key (looking-at class-key)) @@ -14016,7 +14050,8 @@ comment at the start of cc-engine.el for more info." ;; clause - we assume only C++ needs it. (c-syntactic-skip-backward "^;,=" lim t)) (setq placeholder (point)) - (memq (char-before) '(?, ?= ?<))) + (and (memq (char-before) '(?, ?= ?<)) + (not (c-crosses-statement-barrier-p (point) indent-point)))) (cond ;; CASE 5D.6: Something like C++11's "using foo = <type-exp>" diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bc0ae6cc95a..967464ac14d 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,10 +93,15 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) +(cc-bytecomp-defvar c-type-finder-pos) +(cc-bytecomp-defvar c-inhibit-type-finder) +(cc-bytecomp-defvar c-type-finder-timer) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) +(cc-bytecomp-defun c-before-context-fl-expand-region) +(cc-bytecomp-defun c-font-lock-fontify-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -919,13 +924,6 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function does hidden buffer changes. ;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit) - - ;; Clear the list of found types if we start from the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (bobp) - (c-clear-found-types)) - (c-skip-comments-and-strings limit) (when (< (point) limit) @@ -1605,6 +1603,175 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) +(defun c-find-types-background (start limit) + ;; Find any "found types" between START and LIMIT. Allow any such types to + ;; be entered into `c-found-types' by the action of `c-forward-name' or + ;; `c-forward-type' called from this function. This process also causes + ;; occurrences of the type to be prepared for fontification throughout the + ;; buffer. + ;; + ;; Return POINT at the end of the function. This should be at or after + ;; LIMIT, and not later than the next decl-spot after LIMIT. + ;; + ;; This function is called from the timer `c-type-finder-timer'. It may do + ;; hidden buffer changes. + (save-excursion + (save-restriction + (widen) + (goto-char start) + ;; If we're in a (possibly large) literal, skip over it. + (let ((lit-bounds (nth 2 (c-full-pp-to-literal (point))))) + (if lit-bounds + (goto-char (cdr lit-bounds)))) + (when (< (point) limit) + (let (;; o - 'decl if we're in an arglist containing declarations + ;; (but if `c-recognize-paren-inits' is set it might also be + ;; an initializer arglist); + ;; o - '<> if the arglist is of angle bracket type; + ;; o - 'arglist if it's some other arglist; + ;; o - nil, if not in an arglist at all. This includes the + ;; parenthesized condition which follows "if", "while", etc. + context + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. + last-cast-end + ;; The result from `c-forward-decl-or-cast-1'. + decl-or-cast + ;; The maximum of the end positions of all the checked type + ;; decl expressions in the successfully identified + ;; declarations. The position might be either before or + ;; after the syntactic whitespace following the last token + ;; in the type decl expression. + (max-type-decl-end 0) + ;; Same as `max-type-decl-*', but used when we're before + ;; `token-pos'. + (max-type-decl-end-before-token 0) + ) + (goto-char start) + (c-find-decl-spots + limit + c-decl-start-re + nil ; (eval c-maybe-decl-faces) + + (lambda (match-pos inside-macro &optional toplev) + ;; Note to maintainers: don't use `limit' inside this lambda form; + ;; c-find-decl-spots sometimes narrows to less than `limit'. + (if (and c-macro-with-semi-re + (looking-at c-macro-with-semi-re)) + ;; Don't do anything more if we're looking at something that + ;; can't start a declaration. + t + + ;; Set `context' and `c-restricted-<>-arglists'. Look for + ;; "<" for the sake of C++-style template arglists. + ;; "Ignore "(" when it's part of a control flow construct + ;; (e.g. "for ("). + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + + ;; In QT, "more" is an irritating keyword that expands to nothing. + ;; We skip over it to prevent recognition of "more slots: <symbol>" + ;; as a bitfield declaration. + (when (and (c-major-mode-is 'c++-mode) + (looking-at + (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + + ;; Now analyze the construct. This analysis will cause + ;; `c-forward-name' and `c-forward-type' to call `c-add-type', + ;; triggering the desired recognition and fontification of + ;; these found types. + (when (not (eq context 'not-decl)) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + nil) + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point))))) + (t t)))))))) + (point)))) + +(defun c-type-finder-timer-func () + ;; A CC Mode idle timer function for finding "found types". It triggers + ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of + ;; size around `c-type-finder-chunk-size' characters, and runs for (a little + ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted + ;; into `c-found-types', and their occurrences throughout the buffer are + ;; prepared for fontification. + (when (and c-type-finder-time-slot + (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (if c-inhibit-type-finder ; No processing immediately after a GC operation. + (setq c-inhibit-type-finder nil) + (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) + (buf-list (buffer-list))) + ;; One CC Mode buffer needing processing each time around this loop. + (while (and buf-list + (< (float-time) stop-time)) + ;; Cdr through BUF-LIST to find the next buffer needing processing. + (while (and buf-list + (not (with-current-buffer (car buf-list) c-type-finder-pos))) + (setq buf-list (cdr buf-list))) + (when buf-list + (with-current-buffer (car buf-list) + ;; (message "%s" (current-buffer)) ; Useful diagnostic. + (save-restriction + (widen) + ;; Process one `c-type-finder-chunk-size' chunk each time + ;; around this loop. + (while (and c-type-finder-pos + (< (float-time) stop-time)) + ;; Process one chunk per iteration. + (save-match-data + (c-save-buffer-state + (case-fold-search + (beg (marker-position c-type-finder-pos)) + (end (min (+ beg c-type-finder-chunk-size) (point-max))) + (region (c-before-context-fl-expand-region beg end))) + (setq beg (car region) + end (cdr region)) + (setq beg (max (c-find-types-background beg end) end)) + (move-marker c-type-finder-pos + (if (save-excursion (goto-char beg) (eobp)) + nil + beg)) + (when (not (marker-position c-type-finder-pos)) + (setq c-type-finder-pos nil)))))))))))) + ;; Set the timer to run again. + (setq c-type-finder-timer + (run-at-time c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; @@ -2255,6 +2422,47 @@ higher." ;; defvar will install its default value later on. (makunbound def-var))) +;; `c-re-redisplay-timer' is a timer which, when triggered, causes a +;; redisplay. +(defvar c-re-redisplay-timer nil) + +(defun c-force-redisplay (start end) + ;; Force redisplay immediately. This assumes `font-lock-support-mode' is + ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. + (save-excursion (c-font-lock-fontify-region start end)) + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil)) + +(defun c-fontify-new-found-type (type) + ;; Cause the fontification of TYPE, a string, wherever it occurs in the + ;; buffer. If TYPE is currently displayed in a window, cause redisplay to + ;; happen "instantaneously". These actions are done only when jit-lock-mode + ;; is active. + (when (and font-lock-mode + (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (c-save-buffer-state + ((window-boundaries + (mapcar (lambda (win) + (cons (window-start win) + (window-end win))) + (get-buffer-window-list (current-buffer) 'no-mini t))) + (target-re (concat "\\_<" type "\\_>"))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward target-re nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'fontified nil) + (dolist (win-boundary window-boundaries) + (when (and (< (match-beginning 0) (cdr win-boundary)) + (> (match-end 0) (car win-boundary)) + (not c-re-redisplay-timer)) + (setq c-re-redisplay-timer + (run-with-timer 0 nil #'c-force-redisplay + (match-beginning 0) (match-end 0))))))))))) + ;;; C. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c9b7a95df60..f9435c9ceee 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,6 +129,16 @@ ; ' (require 'cc-fonts) ;) +(defvar c-type-finder-timer nil) +;; The variable which holds the repeating idle timer which triggers off the +;; background type finding search. + +(defvar c-inhibit-type-finder nil) +;; When non-nil (set by `c-post-gc-hook') don't perform the type finding +;; activities the next time `c-type-finder-timer' triggers. This ensures +;; keyboard/mouse input will be dealt with when garbage collection is taking a +;; large portion of CPU time. + ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -179,6 +189,18 @@ (when c-buffer-is-cc-mode (save-restriction (widen) + (let ((lst (buffer-list))) + (catch 'found + (dolist (b lst) + (if (and (not (eq b (current-buffer))) + (with-current-buffer b + c-buffer-is-cc-mode)) + (throw 'found nil))) + (remove-hook 'post-command-hook 'c-post-command) + (remove-hook 'post-gc-hook 'c-post-gc-hook) + (and c-type-finder-timer + (progn (cancel-timer c-type-finder-timer) + (setq c-type-finder-timer nil))))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -574,6 +596,12 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) +;; `c-type-finder-pos' is a marker marking the current place in a CC Mode +;; buffer which is due to be searched next for "found types", or nil if the +;; searching is complete. +(defvar c-type-finder-pos nil) +(make-variable-buffer-local 'c-type-finder-pos) + (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -745,6 +773,19 @@ that requires a literal mode spec at compile time." ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) + (add-hook 'post-command-hook 'c-post-command) + (setq c-type-finder-pos + (save-restriction + (widen) + (move-marker (make-marker) (point-min)))) + + ;; Install the functionality for seeking "found types" at mode startup: + (or c-type-finder-timer + (setq c-type-finder-timer + (run-at-time + c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (add-hook 'post-gc-hook #'c-post-gc-hook) + (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -1950,6 +1991,46 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) +;; The next two variables record the bounds of an identifier currently being +;; typed in. These are used to prevent such a partial identifier being +;; recorded as a found type by c-add-type. +(defvar c-new-id-start nil) +(make-variable-buffer-local 'c-new-id-start) +(defvar c-new-id-end nil) +(make-variable-buffer-local 'c-new-id-end) +;; The next variable, when non-nil, records that the previous two variables +;; define a type. +(defvar c-new-id-is-type nil) +(make-variable-buffer-local 'c-new-id-is-type) + +(defun c-update-new-id (end) + ;; Note the bounds of any identifier that END is in or just after, in + ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to + ;; nil. + (save-excursion + (goto-char end) + (let ((id-beg (c-on-identifier))) + (setq c-new-id-start id-beg + c-new-id-end (and id-beg + (progn (c-end-of-current-token) (point))))))) + + +(defun c-post-command () + ;; If point was inside of a new identifier and no longer is, record that + ;; fact. + (when (and c-buffer-is-cc-mode + c-new-id-start c-new-id-end + (or (> (point) c-new-id-end) + (< (point) c-new-id-start))) + (when c-new-id-is-type + (c-add-type-1 c-new-id-start c-new-id-end)) + (setq c-new-id-start nil + c-new-id-end nil + c-new-id-is-type nil))) + +(defun c-post-gc-hook (&optional _stats) ; For XEmacs. + (setq c-inhibit-type-finder t)) + (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -1969,11 +2050,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (unless (c-called-from-text-property-change-p) (save-restriction (widen) + ;; Clear the list of found types if we make a change at the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (eq beg (point-min)) + (c-clear-found-types)) (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' without - ;; an intervening `after-change-functions'. An example of this is bug - ;; #38691. To protect CC Mode, assume that the entire buffer has - ;; changed. + ;; We have two consecutive calls to `before-change-functions' + ;; without an intervening `after-change-functions'. An example of + ;; this is bug #38691. To protect CC Mode, assume that the entire + ;; buffer has changed. (setq beg (point-min) end (point-max) c-just-done-before-change 'whole-buffer) @@ -2151,6 +2237,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c->-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table nil))) + (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. (c-invalidate-sws-region-after beg end old-len) @@ -2549,17 +2636,24 @@ This function is called from `c-common-init', once per mode initialization." At the time of call, point is just after the newly inserted CHAR. -When CHAR is \", t will be returned unless the \" is marked with -a string fence syntax-table text property. For other characters, -the default value of `electric-pair-inhibit-predicate' is called -and its value returned. +When CHAR is \" and not within a comment, t will be returned if +the quotes on the current line are already balanced (i.e. if the +last \" is not marked with a string fence syntax-table text +property). For other cases, the default value of +`electric-pair-inhibit-predicate' is called and its value +returned. This function is the appropriate value of `electric-pair-inhibit-predicate' for CC Mode modes, which mark invalid strings with such a syntax table text property on the opening \" and the next unescaped end of line." - (if (eq char ?\") - (not (equal (get-text-property (1- (point)) 'c-fl-syn-tab) '(15))) + (if (and (eq char ?\") + (not (memq (cadr (c-semi-pp-to-literal (1- (point)))) '(c c++)))) + (let ((last-quote (save-match-data + (save-excursion + (goto-char (c-point 'eoll)) + (search-backward "\""))))) + (not (equal (c-get-char-property last-quote 'c-fl-syn-tab) '(15)))) (funcall (default-value 'electric-pair-inhibit-predicate) char))) diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index c6b6be5b399..4d518838d11 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -444,17 +444,19 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil." defstr)) (prompt (concat symname " offset " defstr)) (keymap (make-sparse-keymap)) - (minibuffer-completion-table obarray) - (minibuffer-completion-predicate 'fboundp) offset input) ;; In principle completing-read is used here, but SPC is unbound ;; to make it less annoying to enter lists. (set-keymap-parent keymap minibuffer-local-completion-map) (define-key keymap " " 'self-insert-command) (while (not offset) - (setq input (read-from-minibuffer prompt nil keymap t - 'c-read-offset-history - (format "%s" oldoff))) + (minibuffer-with-setup-hook + (lambda () + (setq-local minibuffer-completion-table obarray) + (setq-local minibuffer-completion-predicate 'fboundp)) + (setq input (read-from-minibuffer prompt nil keymap t + 'c-read-offset-history + (format "%s" oldoff)))) (if (c-valid-offset input) (setq offset input) ;; error, but don't signal one, keep trying diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index d843c783ed0..40a43c32ed9 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -179,7 +179,7 @@ STYLE stands for the choice where the value is taken from some style setting. PREAMBLE is optionally prepended to FOO; that is, if FOO contains :tag or :value, the respective two-element list component is ignored." - (declare (debug (symbolp form stringp &rest))) + (declare (debug (symbolp form stringp &rest)) (indent defun)) (let* ((expanded-doc (concat doc " This is a style variable. Apart from the valid values described @@ -1524,6 +1524,39 @@ working due to this change." :type 'boolean :group 'c) +(defcustom c-type-finder-time-slot 0.05 + "The length in seconds of a background type search time slot. + +In CC Mode modes, \"found types\" wouldn't always get cleanly +fontified without the background searching for them which happens +in the seconds after starting Emacs or initializing the major +mode. + +This background searching can be disabled by setting this option +to nil." + :type '(choice (const :tag "disabled" nil) + number) + :group 'c) + +(defcustom c-type-finder-repeat-time 0.1 + "The interval, in seconds, at which background type searches occur. + +This interval must be greater than `c-type-finder-time-slot'." + :type 'number + :group 'c) + +(defcustom c-type-finder-chunk-size 1000 + "The size, in characters, of a chunk for background type search. + +Chunks of this size are searched atomically for \"found types\" +just after starting Emacs or initializing the major mode. + +This chunk size is a balance between efficiency (with larger +values) and responsiveness of the keyboard (with smaller values). +See also `c-type-finder-time-slot'." + :type 'integer + :group 'c) + (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ac26f5e9341..6e3589df7ad 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -346,12 +346,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE ;; which is used for non-interactive programs other than ;; compilers (e.g. the "jade:" entry in compilation.txt). - (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") - ;; FIXME: This pattern was added for handling messages - ;; from Ruby, but it is unclear whether it is actually - ;; used since the gcc-include rule above seems to cover - ;; it. - (regexp "[ \t]+\\(?:in \\|from\\)"))) + (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " ")) + ;; Skip indentation generated by GCC's -fanalyzer. + (: (+ " ") "|"))) ;; File name group. (group-n 1 @@ -2228,6 +2225,7 @@ The parent is always `compilation-mode' and the customizable `compilation-...' variables are also set from the name of the mode you have chosen, by replacing the first word, e.g., `compilation-scroll-output' from `grep-scroll-output' if that variable exists." + (declare (indent defun)) (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) `(define-derived-mode ,mode compilation-mode ,name ,doc diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1afeb60ac5f..a23505a9d3b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5951,7 +5951,7 @@ default function." (eval cperl--basic-identifier-rx))) (0+ blank) "(") ;; '("\\<for\\(each\\)?\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" - 4 font-lock-variable-name-face) + 1 font-lock-variable-name-face) ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically '("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face) '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index d800365e66d..baee72b332d 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -702,11 +702,8 @@ BRANCH should be either nil (false branch), t (true branch) or `both'." (x-popup-menu cpp-button-event (list prompt (cons prompt cpp-face-default-list))) (let ((name (car (rassq default cpp-face-default-list)))) - (cdr (assoc (completing-read (if name - (concat prompt - " (default " name "): ") - (concat prompt ": ")) - cpp-face-default-list nil t) + (cdr (assoc (completing-read (format-prompt "%s" name prompt) + cpp-face-default-list nil t) cpp-face-all-list)))) default)) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index ab0329d7eec..0713370da3c 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1330,9 +1330,9 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." "Set the indentation width of the tree display." (interactive) (let ((width (string-to-number (read-string - (concat "Indentation (default " - (int-to-string ebrowse--indentation) - "): ") + (format-prompt + "Indentation" + (int-to-string ebrowse--indentation)) nil nil ebrowse--indentation)))) (when (cl-plusp width) (setq-local ebrowse--indentation width) @@ -4045,23 +4045,27 @@ NUMBER-OF-STATIC-VARIABLES:" (defvar ebrowse-global-map nil "Keymap for Ebrowse commands.") - (defvar ebrowse-global-prefix-key "\C-c\C-m" "Prefix key for Ebrowse commands.") - -(defvar ebrowse-global-submap-4 nil - "Keymap used for `ebrowse-global-prefix' followed by `4'.") - - -(defvar ebrowse-global-submap-5 nil - "Keymap used for `ebrowse-global-prefix' followed by `5'.") - +(defvar-keymap ebrowse-global-submap-4 + :doc "Keymap used for `ebrowse-global-prefix' followed by `4'." + "." #'ebrowse-tags-find-definition-other-window + "f" #'ebrowse-tags-find-definition-other-window + "v" #'ebrowse-tags-find-declaration-other-window + "F" #'ebrowse-tags-view-definition-other-window + "V" #'ebrowse-tags-view-declaration-other-window) + +(defvar-keymap ebrowse-global-submap-5 + :doc "Keymap used for `ebrowse-global-prefix' followed by `5'." + "." #'ebrowse-tags-find-definition-other-frame + "f" #'ebrowse-tags-find-definition-other-frame + "v" #'ebrowse-tags-find-declaration-other-frame + "F" #'ebrowse-tags-view-definition-other-frame + "V" #'ebrowse-tags-view-declaration-other-frame) (unless ebrowse-global-map (setq ebrowse-global-map (make-sparse-keymap)) - (setq ebrowse-global-submap-4 (make-sparse-keymap)) - (setq ebrowse-global-submap-5 (make-sparse-keymap)) (define-key ebrowse-global-map "a" 'ebrowse-tags-apropos) (define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer) (define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack) @@ -4082,17 +4086,7 @@ NUMBER-OF-STATIC-VARIABLES:" (define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list) (define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol) (define-key ebrowse-global-map "4" ebrowse-global-submap-4) - (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window) - (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window) - (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window) - (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window) - (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window) (define-key ebrowse-global-map "5" ebrowse-global-submap-5) - (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame) - (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame) - (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame) - (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame) - (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame) (define-key global-map ebrowse-global-prefix-key ebrowse-global-map)) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9522055670d..7da93a351a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -636,7 +636,8 @@ functions are annotated with \"<f>\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (quoted (list nil (elisp--completion-local-symbols) ;; Don't include all symbols (bug#16646). @@ -652,7 +653,8 @@ functions are annotated with \"<f>\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (t (list nil (completion-table-merge elisp--local-variables-completion-table @@ -667,7 +669,8 @@ functions are annotated with \"<f>\" via the 'variable)) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location))) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated))) ;; Looks like a funcall position. Let's double check. (save-excursion (goto-char (1- beg)) @@ -714,13 +717,15 @@ functions are annotated with \"<f>\" via the :company-kind (lambda (_) 'variable) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (_ (list nil (elisp--completion-local-symbols) :predicate #'elisp--shorthand-aware-fboundp :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated )))))))) (nconc (list beg end) (if (null (car table-etc)) @@ -743,6 +748,11 @@ functions are annotated with \"<f>\" via the ((facep sym) 'color) (t 'text)))) +(defun elisp--company-deprecated (str) + (let ((sym (intern-soft str))) + (or (get sym 'byte-obsolete-variable) + (get sym 'byte-obsolete-info)))) + (defun lisp-completion-at-point (&optional _predicate) (declare (obsolete elisp-completion-at-point "25.1")) (elisp-completion-at-point)) diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el new file mode 100644 index 00000000000..a12c964c250 --- /dev/null +++ b/lisp/progmodes/erts-mode.el @@ -0,0 +1,225 @@ +;;; erts-mode.el --- major mode to edit erts files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Keywords: tools + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'ert) + +(defgroup erts-mode nil + "Major mode for editing Emacs test files." + :group 'lisp) + +(defface erts-mode-specification-name + '((((class color) + (background dark)) + :foreground "green") + (((class color) + (background light)) + :foreground "cornflower blue") + (t + :bold t)) + "Face used for displaying specification names." + :group 'erts-mode) + +(defface erts-mode-specification-value + '((((class color) + (background dark)) + :foreground "DeepSkyBlue1") + (((class color) + (background light)) + :foreground "blue") + (t + :bold t)) + "Face used for displaying specificaton values." + :group 'erts-mode) + +(defface erts-mode-start-test + '((t :inherit font-lock-keyword-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defface erts-mode-end-test + '((t :inherit font-lock-comment-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defvar erts-mode-map + (let ((map (make-keymap))) + (set-keymap-parent map prog-mode-map) + (define-key map "\C-c\C-r" 'erts-tag-region) + (define-key map "\C-c\C-c" 'erts-run-test) + map)) + +(defvar erts-mode-font-lock-keywords + ;; Specifications. + `((erts-mode--match-not-in-test + ("^\\([^ \t\n:]+:\\)[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?" + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'erts-mode-specification-name) + (2 'erts-mode-specification-value))) + ("^=-=$" 0 'erts-mode-start-test) + ("^=-=-=$" 0 'erts-mode-end-test))) + +(defun erts-mode--match-not-in-test (_limit) + (when (erts-mode--in-test-p (point)) + (erts-mode--end-of-test)) + (let ((start (point))) + (goto-char + (if (re-search-forward "^=-=$" nil t) + (match-beginning 0) + (point-max))) + (if (< (point) start) + nil + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) + +(defun erts-mode--end-of-test () + (search-forward "^=-=-=\n" nil t)) + +(defun erts-mode--in-test-p (point) + "Say whether POINT is in a test." + (save-excursion + (goto-char point) + (beginning-of-line) + (if (looking-at "=-=\\(-=\\)?$") + t + (let ((test-start (save-excursion + (re-search-backward "^=-=\n" nil t)))) + ;; Before the first test. + (and test-start + (let ((test-end (re-search-backward "^=-=-=\n" nil t))) + (or (null test-end) + ;; Between tests. + (> test-start test-end)))))))) + +;;;###autoload +(define-derived-mode erts-mode prog-mode "erts" + "Major mode for editing erts (Emacs testing) files. +This mode mainly provides some font locking. + +\\{erts-mode-map}" + (setq-local font-lock-defaults '(erts-mode-font-lock-keywords t))) + +(defun erts-tag-region (start end name) + "Tag the region between START and END as a test. +Interactively, this is the region. + +NAME should be a string appropriate for output by ert if the test fails. +If NAME is nil or the empty string, a name will be auto-generated." + (interactive "r\nsTest name: " erts-mode) + ;; Automatically make a name. + (when (zerop (length name)) + (save-excursion + (goto-char (point-min)) + (let ((names nil)) + (while (re-search-forward "^Name:[ \t]*\\(.*\\)" nil t) + (let ((name (match-string 1))) + (unless (erts-mode--in-test-p (point)) + (push name names)))) + (setq name + (cl-loop with base = (file-name-sans-extension (buffer-name)) + for i from 1 + for name = (format "%s%d" base i) + unless (member name names) + return name))))) + (save-excursion + (goto-char end) + (unless (bolp) + (insert "\n")) + (insert "=-=-=\n") + (goto-char start) + (insert "Name: " name "\n\n") + (insert "=-=\n"))) + +(defun erts-mode--preceding-spec (name) + (save-excursion + ;; Find the name, but skip if it's in a test. + (while (and (re-search-backward (format "^%s:" name) nil t) + (erts-mode--in-test-p (point)))) + (and (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=$" nil t) + (progn + (goto-char (match-beginning 0)) + (cdr (assq (intern (downcase name)) + (ert--erts-specifications (point)))))))) + +(defun erts-run-test (test-function &optional verbose) + "Run the current test. +If the current erts file doesn't define a test function, the user +will be prompted for one. + +If VERBOSE (interactively, the prefix), display a diff of the +expected results and the actual results in a separate buffer." + (interactive + (list (or (erts-mode--preceding-spec "Code") + (read-string "Transformation function: ")) + current-prefix-arg) + erts-mode) + (save-excursion + (erts-mode--goto-start-of-test) + (condition-case arg + (ert-test--erts-test + (list (cons 'dummy t) + (cons 'code (car (read-from-string test-function))) + (cons 'point-char (erts-mode--preceding-spec "Point-Char"))) + (buffer-file-name)) + (:success (message "Test successful")) + (ert-test-failed + (if (not verbose) + (message "Test failure; result: \n%s" + (substring-no-properties (cadr (cadr arg)))) + (message "Test failure") + (let (expected got) + (unwind-protect + (progn + (with-current-buffer + (setq expected (generate-new-buffer "erts expected")) + (insert (nth 1 (cadr arg)))) + (with-current-buffer + (setq got (generate-new-buffer "erts results")) + (insert (nth 2 (cadr arg)))) + (diff-buffers expected got)) + (kill-buffer expected) + (kill-buffer got)))))))) + +(defun erts-mode--goto-start-of-test () + (if (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=\n" nil t) + (re-search-backward "^=-=\n" nil t) + (let ((potential-start (match-end 0))) + ;; See if we're in a two-clause ("before" and "after") test or not. + (if-let ((start (and (save-excursion (re-search-backward "^=-=\n" nil t)) + (match-end 0)))) + (let ((end (save-excursion (re-search-backward "^=-=-=\n" nil t)))) + (if (or (not end) + (> start end)) + ;; We are, so go to the real start. + (goto-char start) + (goto-char potential-start))) + (goto-char potential-start))))) + +(provide 'erts-mode) + +;;; erts-mode.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index f53b09d9e8c..d7dbaa06505 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -145,7 +145,9 @@ Otherwise, `find-tag-default' is used." :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length - 'xref-marker-ring-length "25.1") + 'tags-location-ring-length "25.1") + +(defvar tags-location-ring-length 16) (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." @@ -180,10 +182,11 @@ Example value: (sexp :tag "Tags to search"))) :version "21.1") -(defvaralias 'find-tag-marker-ring 'xref--marker-ring) +;; Obsolete variable kept for compatibility. We don't use it in any way. +(defvar find-tag-marker-ring (make-ring 16)) (make-obsolete-variable 'find-tag-marker-ring - "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead." + "use `xref-push-marker-stack' or `xref-go-back' instead." "25.1") (defvar default-tags-table-function nil @@ -191,7 +194,7 @@ Example value: This function receives no arguments and should return the default tags table file to use for the current buffer.") -(defvar tags-location-ring (make-ring xref-marker-ring-length) +(defvar tags-location-ring (make-ring tags-location-ring-length) "Ring of markers which are locations visited by \\[find-tag]. Pop back to the last location with \\[negative-argument] \\[find-tag].") @@ -292,7 +295,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 +628,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)))))) @@ -731,13 +734,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (interactive) ;; Clear out the markers we are throwing away. (let ((i 0)) - (while (< i xref-marker-ring-length) + (while (< i tags-location-ring-length) (if (aref (cddr tags-location-ring) i) (set-marker (aref (cddr tags-location-ring) i) nil)) (setq i (1+ i)))) (xref-clear-marker-stack) (setq tags-file-name nil - tags-location-ring (make-ring xref-marker-ring-length) + tags-location-ring (make-ring tags-location-ring-length) tags-table-list nil tags-table-computed-list nil tags-table-computed-list-for nil @@ -1068,7 +1071,7 @@ See documentation of variable `tags-file-name'." regexp next-p t)) ;;;###autoload -(defalias 'pop-tag-mark 'xref-pop-marker-stack) +(defalias 'pop-tag-mark 'xref-go-back) (defvar tag-lines-already-matched nil @@ -1989,7 +1992,8 @@ see the doc of that variable if you want to add names to the list." (setq set-list (delete (car set-list) set-list))) (goto-char (point-min)) (insert-before-markers - "Type `t' to select a tags table or set of tags tables:\n\n") + (substitute-command-keys + "Type \\`t' to select a tags table or set of tags tables:\n\n")) (if desired-point (goto-char desired-point)) (set-window-start (selected-window) 1 t)) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index f9e6101e7ab..eb6da20ff7f 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -345,6 +345,7 @@ The options are `downcase-word', `upcase-word', `capitalize-word' and nil." ;; there are spaces. "contiguous" "submodule" "concurrent" "codimension" "sync all" "sync memory" "critical" "image_index" "error stop" + "impure" )) "\\_>") "Regexp used by the function `f90-change-keywords'.") @@ -646,7 +647,7 @@ do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ forall\\|block\\|critical\\)\\)\\_>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. - '("\\_<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ + '("\\_<\\(implicit\\)[ \t]+\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ \\|enumerator\\|procedure\\|\ logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t]*" (1 font-lock-keyword-face) (2 font-lock-type-face)) @@ -656,8 +657,10 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) "\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\ return\\)\\_>" - '("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" + '("\\_<\\(exit\\|cycle\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) + '("\\_<\\(exit\\|cycle\\)\\_>" + (1 font-lock-keyword-face)) '("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) ;; F2003 "class default". '("\\_<\\(class\\)[ \t]*default" . 1) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 66adc4e9ef8..409ff940d96 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1266,7 +1266,7 @@ Used by Speedbar." :version "22.1") (define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) -(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch) +(keymap-set gud-global-map "C-w" 'gud-watch) (declare-function tooltip-identifier-from-point "tooltip" (point)) @@ -1612,6 +1612,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) + (declare (indent defun)) `(defun ,name (&optional thread) ,(when doc doc) (message "%s" thread) @@ -3012,6 +3013,7 @@ calling `gdb-current-context-command'). Triggers defined by this command are meant to be used as a trigger argument when describing buffer types with `gdb-set-buffer-rules'." + (declare (indent defun)) `(defun ,trigger-name (&optional signal) (when (or (not ,signal-list) @@ -3032,6 +3034,7 @@ Erase current buffer and evaluate CUSTOM-DEFUN. Then call `gdb-update-buffer-name'. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." + (declare (indent defun)) `(defun ,handler-name () (let* ((inhibit-read-only t) ,@(unless nopreserve @@ -3055,6 +3058,7 @@ See `def-gdb-auto-update-trigger'. HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See `def-gdb-auto-update-handler'." + (declare (indent defun)) `(progn (def-gdb-auto-update-trigger ,trigger-name ,gdb-command @@ -3473,6 +3477,7 @@ corresponding to the mode line clicked." CUSTOM-DEFUN may use locally bound `thread' variable, which will be the value of `gdb-thread' property of the current line. If `gdb-thread' is nil, error is signaled." + (declare (indent defun)) `(defun ,name (&optional event) ,(when doc doc) (interactive (list last-input-event)) @@ -3488,6 +3493,7 @@ If `gdb-thread' is nil, error is signaled." &optional doc) "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (,buffer-command (gdb-mi--field thread 'id)) ,doc)) @@ -3543,6 +3549,7 @@ on the current line." "Define a NAME which will execute GUD-COMMAND with `gdb-thread-number' locally bound to id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (if gdb-non-stop (let ((gdb-thread-number (gdb-mi--field thread 'id)) @@ -3711,6 +3718,7 @@ in `gdb-memory-format'." (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) "Define a function NAME which reads new VAR value from minibuffer." + (declare (indent defun)) `(defun ,name (event) ,(when doc doc) (interactive "e") @@ -3739,6 +3747,7 @@ in `gdb-memory-format'." "Define a function NAME to switch memory buffer to use FORMAT. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-format ,format) @@ -3808,6 +3817,7 @@ DOC is an optional documentation string." "Define a function NAME to switch memory unit size to UNIT-SIZE. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-unit ,unit-size) @@ -3832,6 +3842,7 @@ The defined function switches Memory buffer to show address stored in ADDRESS-VAR variable. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name ,(when doc doc) (interactive) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 9be3af79f9d..70c55c01dd7 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1057,11 +1057,9 @@ REGEXP is used as a string in the prompt." default-extension (car grep-files-history) (car (car grep-files-aliases)))) - (files (completing-read - (concat "Search for \"" regexp - "\" in files matching wildcard" - (if default (concat " (default " default ")")) - ": ") + (files (completing-read + (format-prompt "Search for \"%s\" in files matching wildcard" + default regexp) #'read-file-name-internal nil nil nil 'grep-files-history (delete-dups diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 2061d414802..d5bd2655174 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -90,8 +90,10 @@ pdb (Python), and jdb." "Prefix of all GUD commands valid in C buffers." :type 'key-sequence) -(global-set-key (vconcat gud-key-prefix "\C-l") #'gud-refresh) -;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack +(defvar-keymap gud-global-map + "C-l" #'gud-refresh) + +(global-set-key gud-key-prefix gud-global-map) (defvar gud-marker-filter nil) (put 'gud-marker-filter 'permanent-local t) @@ -433,7 +435,7 @@ we're in the GUD buffer)." ;; Unused lexical warning if cmd does not use "arg". cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) #',func)) - ,(if key `(global-set-key (vconcat gud-key-prefix ,key) #',func)))) + ,(if key `(define-key gud-global-map ,key #',func)))) ;; Where gud-display-frame should put the debugging arrow; a cons of ;; (filename . line-number). This is set by the marker-filter, which scans @@ -3539,8 +3541,8 @@ Treats actions as defuns." #'gdb-script-end-of-defun) (setq-local font-lock-defaults '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face))) + (font-lock-syntactic-face-function + . gdb-script-font-lock-syntactic-face))) ;; Recognize docstrings. (setq-local syntax-propertize-function gdb-script-syntax-propertize-function) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index a18a67249ae..87732c10489 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -2456,7 +2456,7 @@ This allows #ifdef VAR to be hidden." (t nil)))) (var (read-minibuffer "Define what? " default)) - (val (read-from-minibuffer (format "Set %s to? (default 1): " var) + (val (read-from-minibuffer (format-prompt "Set %s to?" "1" var) nil nil t nil "1"))) (list var val))) (hif-set-var var (or val 1)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 5a31ad35087..ded3a9c463c 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -817,7 +817,7 @@ IDL has currently stepped.") Command history, searching of previous commands, command line editing are available via the comint-mode key bindings, by default - mostly on the key `C-c'. Command history is also available with + mostly on the key \\`C-c'. Command history is also available with the arrow keys UP and DOWN. 2. Completion @@ -1327,7 +1327,7 @@ See also the variable `idlwave-shell-input-mode-spells'." Characters are sent one by one, without newlines. The loop is blocking and intercepts all input events to Emacs. You can use this command to interact with the IDL command GET_KBRD. -The loop can be aborted by typing `C-g'. The loop also exits automatically +The loop can be aborted by typing \\[keyboard-quit]. The loop also exits automatically when the IDL prompt gets displayed again after the current IDL command." (interactive) @@ -1342,7 +1342,8 @@ when the IDL prompt gets displayed again after the current IDL command." (funcall errf "No IDL program seems to be waiting for input")) ;; OK, start the loop - (message "Character mode on: Sending single chars (`C-g' to exit)") + (message (substitute-command-keys + "Character mode on: Sending single chars (\\[keyboard-quit] to exit)")) (message (catch 'exit (while t diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 845ca8609d7..9303f1ecb91 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -33,7 +33,7 @@ ;; The main features of this JavaScript mode are syntactic ;; highlighting (enabled with `font-lock-mode' or ;; `global-font-lock-mode'), automatic indentation and filling of -;; comments, C preprocessor fontification, and MozRepl integration. +;; comments, and C preprocessor fontification. ;; ;; General Remarks: ;; @@ -51,7 +51,6 @@ (require 'cc-fonts)) (require 'newcomment) (require 'imenu) -(require 'moz nil t) (require 'json) (require 'prog-mode) @@ -59,12 +58,9 @@ (require 'cl-lib) (require 'ido)) -(defvar inferior-moz-buffer) -(defvar moz-repl-name) (defvar ido-cur-list) (defvar electric-layout-rules) (declare-function ido-mode "ido" (&optional arg)) -(declare-function inferior-moz-process "ext:mozrepl" ()) ;;; Constants @@ -95,7 +91,7 @@ name.") (defconst js--plain-method-re (concat "^\\s-*?\\(" js--dotted-name-re "\\)\\.prototype" - "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(function\\)\\_>") + "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(\\(:?async[ \t\n]+\\)function\\)\\_>") "Regexp matching an explicit JavaScript prototype \"method\" declaration. Group 1 is a (possibly-dotted) class name, group 2 is a method name, and group 3 is the `function' keyword.") @@ -485,25 +481,22 @@ seldom use, either globally or on a per-buffer basis." (list 'const x)) js--available-frameworks))) -(defcustom js-js-switch-tabs - (and (memq system-type '(darwin)) t) +(defvar js-js-switch-tabs (and (memq system-type '(darwin)) t) "Whether `js-mode' should display tabs while selecting them. This is useful only if the windowing system has a good mechanism -for preventing Firefox from stealing the keyboard focus." - :type 'boolean) +for preventing Firefox from stealing the keyboard focus.") +(make-obsolete-variable 'js-js-switch-tabs "MozRepl no longer exists" "28.1") -(defcustom js-js-tmpdir - (locate-user-emacs-file "js/js") +(defvar js-js-tmpdir (locate-user-emacs-file "js/js") "Temporary directory used by `js-mode' to communicate with Mozilla. -This directory must be readable and writable by both Mozilla and Emacs." - :type 'directory - :version "28.1") +This directory must be readable and writable by both Mozilla and Emacs.") +(make-obsolete-variable 'js-js-tmpdir "MozRepl no longer exists" "28.1") -(defcustom js-js-timeout 5 +(defvar js-js-timeout 5 "Reply timeout for executing commands in Mozilla via `js-mode'. The value is given in seconds. Increase this value if you are -getting timeout messages." - :type 'integer) +getting timeout messages.") +(make-obsolete-variable 'js-js-timeout "MozRepl no longer exists" "28.1") (defcustom js-indent-first-init nil "Non-nil means specially indent the first variable declaration's initializer. @@ -671,18 +664,7 @@ This variable is like `sgml-attribute-offset'." (defvar js-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap [(control ?c) (meta ?:)] #'js-eval) - (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context) - (define-key keymap [(control meta ?x)] #'js-eval-defun) (define-key keymap [(meta ?.)] #'js-find-symbol) - (easy-menu-define nil keymap "JavaScript Menu" - '("JavaScript" - ["Select New Mozilla Context..." js-set-js-context - (fboundp #'inferior-moz-process)] - ["Evaluate Expression in Mozilla Context..." js-eval - (fboundp #'inferior-moz-process)] - ["Send Current Function to Mozilla..." js-eval-defun - (fboundp #'inferior-moz-process)])) keymap) "Keymap for `js-mode'.") @@ -932,9 +914,10 @@ This puts point at the `function' keyword. If this is a syntactically-correct non-expression function, return the name of the function, or t if the name could not be determined. Otherwise, return nil." - (cl-assert (looking-at "\\_<function\\_>")) + (unless (looking-at "\\(\\_<async\\_>[ \t\n]+\\)?\\_<function\\_>") + (error "Invalid position")) (let ((name t)) - (forward-word-strictly) + (goto-char (match-end 0)) (forward-comment most-positive-fixnum) (when (eq (char-after) ?*) (forward-char) @@ -970,14 +953,17 @@ If POS is not in a function prologue, return nil." (goto-char (match-end 0)))) (skip-syntax-backward "w_") - (and (or (looking-at "\\_<function\\_>") - (js--re-search-backward "\\_<function\\_>" nil t)) - - (save-match-data (goto-char (match-beginning 0)) - (js--forward-function-decl)) - - (<= pos (point)) - (or prologue-begin (match-beginning 0)))))) + (let ((start nil)) + (and (or (looking-at "\\_<function\\_>") + (js--re-search-backward "\\_<function\\_>" nil t)) + (progn + (setq start (match-beginning 0)) + (goto-char start) + (when (looking-back "\\_<async\\_>[ \t\n]+" (- (point) 30)) + (setq start (match-beginning 0))) + (js--forward-function-decl)) + (<= pos (point)) + (or prologue-begin start)))))) (defun js--beginning-of-defun-raw () "Helper function for `js-beginning-of-defun'. @@ -1247,7 +1233,6 @@ LIMIT defaults to point." ;; Regular function declaration ((and (looking-at "\\_<function\\_>") (setq name (js--forward-function-decl))) - (when (eq name t) (setq name (js--guess-function-name orig-match-end)) (if name @@ -1259,6 +1244,11 @@ LIMIT defaults to point." (cl-assert (eq (char-after) ?{)) (forward-char) + (save-excursion + (goto-char orig-match-start) + (when (looking-back "\\_<async\\_>[ \t\n]+" + (- (point) 30)) + (setq orig-match-start (match-beginning 0)))) (make-js--pitem :paren-depth orig-depth :h-begin orig-match-start @@ -3308,10 +3298,7 @@ marker." (setf (car bounds) (point)))) (buffer-substring (car bounds) (cdr bounds))))) -(defvar find-tag-marker-ring) ; etags - -;; etags loads ring. -(declare-function ring-insert "ring" (ring item)) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun js-find-symbol (&optional arg) "Read a JavaScript symbol and jump to it. @@ -3319,7 +3306,7 @@ With a prefix argument, restrict symbols to those from the current buffer. Pushes a mark onto the tag ring just like `find-tag'." (interactive "P") - (require 'etags) + (require 'xref) (let (symbols marker) (if (not arg) (setq symbols (js--get-all-known-symbols)) @@ -3331,1111 +3318,11 @@ current buffer. Pushes a mark onto the tag ring just like symbols "Jump to: " (js--guess-symbol-at-point)))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (switch-to-buffer (marker-buffer marker)) (push-mark) (goto-char marker))) -;;; MozRepl integration - -(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) -(define-error 'js-js-error "JavaScript Error") ;; '(js-error error)) - -(defun js--wait-for-matching-output - (process regexp timeout &optional start) - "Wait TIMEOUT seconds for PROCESS to output a match for REGEXP. -On timeout, return nil. On success, return t with match data -set. If START is non-nil, look for output starting from START. -Otherwise, use the current value of `process-mark'." - (with-current-buffer (process-buffer process) - (cl-loop with start-pos = (or start - (marker-position (process-mark process))) - with end-time = (time-add nil timeout) - for time-left = (float-time (time-subtract end-time nil)) - do (goto-char (point-max)) - if (looking-back regexp start-pos) return t - while (> time-left 0) - do (accept-process-output process time-left nil t) - do (goto-char (process-mark process)) - finally do (signal - 'js-moz-bad-rpc - (list (format "Timed out waiting for output matching %S" regexp)))))) - -(cl-defstruct js--js-handle - ;; Integer, mirrors the value we see in JS - (id nil :read-only t) - - ;; Process to which this thing belongs - (process nil :read-only t)) - -(defun js--js-handle-expired-p (x) - (not (eq (js--js-handle-process x) - (inferior-moz-process)))) - -(defvar js--js-references nil - "Maps Elisp JavaScript proxy objects to their JavaScript IDs.") - -(defvar js--js-process nil - "The most recent MozRepl process object.") - -(defvar js--js-gc-idle-timer nil - "Idle timer for cleaning up JS object references.") - -(defvar js--js-last-gcs-done nil) - -(defconst js--moz-interactor - (replace-regexp-in-string - "[ \n]+" " " - ; */" Make Emacs happy -"(function(repl) { - repl.defineInteractor('js', { - onStart: function onStart(repl) { - if(!repl._jsObjects) { - repl._jsObjects = {}; - repl._jsLastID = 0; - repl._jsGC = this._jsGC; - } - this._input = ''; - }, - - _jsGC: function _jsGC(ids_in_use) { - var objects = this._jsObjects; - var keys = []; - var num_freed = 0; - - for(var pn in objects) { - keys.push(Number(pn)); - } - - keys.sort(function(x, y) x - y); - ids_in_use.sort(function(x, y) x - y); - var i = 0; - var j = 0; - - while(i < ids_in_use.length && j < keys.length) { - var id = ids_in_use[i++]; - while(j < keys.length && keys[j] !== id) { - var k_id = keys[j++]; - delete objects[k_id]; - ++num_freed; - } - ++j; - } - - while(j < keys.length) { - var k_id = keys[j++]; - delete objects[k_id]; - ++num_freed; - } - - return num_freed; - }, - - _mkArray: function _mkArray() { - var result = []; - for(var i = 0; i < arguments.length; ++i) { - result.push(arguments[i]); - } - return result; - }, - - _parsePropDescriptor: function _parsePropDescriptor(parts) { - if(typeof parts === 'string') { - parts = [ parts ]; - } - - var obj = parts[0]; - var start = 1; - - if(typeof obj === 'string') { - obj = window; - start = 0; - } else if(parts.length < 2) { - throw new Error('expected at least 2 arguments'); - } - - for(var i = start; i < parts.length - 1; ++i) { - obj = obj[parts[i]]; - } - - return [obj, parts[parts.length - 1]]; - }, - - _getProp: function _getProp(/*...*/) { - if(arguments.length === 0) { - throw new Error('no arguments supplied to getprop'); - } - - if(arguments.length === 1 && - (typeof arguments[0]) !== 'string') - { - return arguments[0]; - } - - var [obj, propname] = this._parsePropDescriptor(arguments); - return obj[propname]; - }, - - _putProp: function _putProp(properties, value) { - var [obj, propname] = this._parsePropDescriptor(properties); - obj[propname] = value; - }, - - _delProp: function _delProp(propname) { - var [obj, propname] = this._parsePropDescriptor(arguments); - delete obj[propname]; - }, - - _typeOf: function _typeOf(thing) { - return typeof thing; - }, - - _callNew: function(constructor) { - if(typeof constructor === 'string') - { - constructor = window[constructor]; - } else if(constructor.length === 1 && - typeof constructor[0] !== 'string') - { - constructor = constructor[0]; - } else { - var [obj,propname] = this._parsePropDescriptor(constructor); - constructor = obj[propname]; - } - - /* Hacky, but should be robust */ - var s = 'new constructor('; - for(var i = 1; i < arguments.length; ++i) { - if(i != 1) { - s += ','; - } - - s += 'arguments[' + i + ']'; - } - - s += ')'; - return eval(s); - }, - - _callEval: function(thisobj, js) { - return eval.call(thisobj, js); - }, - - getPrompt: function getPrompt(repl) { - return 'EVAL>' - }, - - _lookupObject: function _lookupObject(repl, id) { - if(typeof id === 'string') { - switch(id) { - case 'global': - return window; - case 'nil': - return null; - case 't': - return true; - case 'false': - return false; - case 'undefined': - return undefined; - case 'repl': - return repl; - case 'interactor': - return this; - case 'NaN': - return NaN; - case 'Infinity': - return Infinity; - case '-Infinity': - return -Infinity; - default: - throw new Error('No object with special id:' + id); - } - } - - var ret = repl._jsObjects[id]; - if(ret === undefined) { - throw new Error('No object with id:' + id + '(' + typeof id + ')'); - } - return ret; - }, - - _findOrAllocateObject: function _findOrAllocateObject(repl, value) { - if(typeof value !== 'object' && typeof value !== 'function') { - throw new Error('_findOrAllocateObject called on non-object(' - + typeof(value) + '): ' - + value) - } - - for(var id in repl._jsObjects) { - id = Number(id); - var obj = repl._jsObjects[id]; - if(obj === value) { - return id; - } - } - - var id = ++repl._jsLastID; - repl._jsObjects[id] = value; - return id; - }, - - _fixupList: function _fixupList(repl, list) { - for(var i = 0; i < list.length; ++i) { - if(list[i] instanceof Array) { - this._fixupList(repl, list[i]); - } else if(typeof list[i] === 'object') { - var obj = list[i]; - if(obj.funcall) { - var parts = obj.funcall; - this._fixupList(repl, parts); - var [thisobj, func] = this._parseFunc(parts[0]); - list[i] = func.apply(thisobj, parts.slice(1)); - } else if(obj.objid) { - list[i] = this._lookupObject(repl, obj.objid); - } else { - throw new Error('Unknown object type: ' + obj.toSource()); - } - } - } - }, - - _parseFunc: function(func) { - var thisobj = null; - - if(typeof func === 'string') { - func = window[func]; - } else if(func instanceof Array) { - if(func.length === 1 && typeof func[0] !== 'string') { - func = func[0]; - } else { - [thisobj, func] = this._parsePropDescriptor(func); - func = thisobj[func]; - } - } - - return [thisobj,func]; - }, - - _encodeReturn: function(value, array_as_mv) { - var ret; - - if(value === null) { - ret = ['special', 'null']; - } else if(value === true) { - ret = ['special', 'true']; - } else if(value === false) { - ret = ['special', 'false']; - } else if(value === undefined) { - ret = ['special', 'undefined']; - } else if(typeof value === 'number') { - if(isNaN(value)) { - ret = ['special', 'NaN']; - } else if(value === Infinity) { - ret = ['special', 'Infinity']; - } else if(value === -Infinity) { - ret = ['special', '-Infinity']; - } else { - ret = ['atom', value]; - } - } else if(typeof value === 'string') { - ret = ['atom', value]; - } else if(array_as_mv && value instanceof Array) { - ret = ['array', value.map(this._encodeReturn, this)]; - } else { - ret = ['objid', this._findOrAllocateObject(repl, value)]; - } - - return ret; - }, - - _handleInputLine: function _handleInputLine(repl, line) { - var ret; - var array_as_mv = false; - - try { - if(line[0] === '*') { - array_as_mv = true; - line = line.substring(1); - } - var parts = eval(line); - this._fixupList(repl, parts); - var [thisobj, func] = this._parseFunc(parts[0]); - ret = this._encodeReturn( - func.apply(thisobj, parts.slice(1)), - array_as_mv); - } catch(x) { - ret = ['error', x.toString() ]; - } - - var JSON = Components.classes['@mozilla.org/dom/json;1'].createInstance(Components.interfaces.nsIJSON); - repl.print(JSON.encode(ret)); - repl._prompt(); - }, - - handleInput: function handleInput(repl, chunk) { - this._input += chunk; - var match, line; - while(match = this._input.match(/.*\\n/)) { - line = match[0]; - - if(line === 'EXIT\\n') { - repl.popInteractor(); - repl._prompt(); - return; - } - - this._input = this._input.substring(line.length); - this._handleInputLine(repl, line); - } - } - }); -}) -") - - "String to set MozRepl up into a simple-minded evaluation mode.") - -(defun js--js-encode-value (x) - "Marshall the given value for JS. -Strings and numbers are JSON-encoded. Lists (including nil) are -made into JavaScript array literals and their contents encoded -with `js--js-encode-value'." - (cond ((or (stringp x) (numberp x)) (json-encode x)) - ((symbolp x) (format "{objid:%S}" (symbol-name x))) - ((js--js-handle-p x) - - (when (js--js-handle-expired-p x) - (error "Stale JS handle")) - - (format "{objid:%s}" (js--js-handle-id x))) - - ((sequencep x) - (if (eq (car-safe x) 'js--funcall) - (format "{funcall:[%s]}" - (mapconcat #'js--js-encode-value (cdr x) ",")) - (concat - "[" (mapconcat #'js--js-encode-value x ",") "]"))) - (t - (error "Unrecognized item: %S" x)))) - -(defconst js--js-prompt-regexp "\\(repl[0-9]*\\)> $") -(defconst js--js-repl-prompt-regexp "^EVAL>$") -(defvar js--js-repl-depth 0) - -(defun js--js-wait-for-eval-prompt () - (js--wait-for-matching-output - (inferior-moz-process) - js--js-repl-prompt-regexp js-js-timeout - - ;; start matching against the beginning of the line in - ;; order to catch a prompt that's only partially arrived - (save-excursion (forward-line 0) (point)))) - -;; Presumably "inferior-moz-process" loads comint. -(declare-function comint-send-string "comint" (process string)) -(declare-function comint-send-input "comint" - (&optional no-newline artificial)) - -(defun js--js-enter-repl () - (inferior-moz-process) ; called for side-effect - (with-current-buffer inferior-moz-buffer - (goto-char (point-max)) - - ;; Do some initialization the first time we see a process - (unless (eq (inferior-moz-process) js--js-process) - (setq js--js-process (inferior-moz-process)) - (setq js--js-references (make-hash-table :test 'eq :weakness t)) - (setq js--js-repl-depth 0) - - ;; Send interactor definition - (comint-send-string js--js-process js--moz-interactor) - (comint-send-string js--js-process - (concat "(" moz-repl-name ")\n")) - (js--wait-for-matching-output - (inferior-moz-process) js--js-prompt-regexp - js-js-timeout)) - - ;; Sanity check - (when (looking-back js--js-prompt-regexp - (save-excursion (forward-line 0) (point))) - (setq js--js-repl-depth 0)) - - (if (> js--js-repl-depth 0) - ;; If js--js-repl-depth > 0, we *should* be seeing an - ;; EVAL> prompt. If we don't, give Mozilla a chance to catch - ;; up with us. - (js--js-wait-for-eval-prompt) - - ;; Otherwise, tell Mozilla to enter the interactor mode - (insert (match-string-no-properties 1) - ".pushInteractor('js')") - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) js--js-repl-prompt-regexp - js-js-timeout)) - - (cl-incf js--js-repl-depth))) - -(defun js--js-leave-repl () - (cl-assert (> js--js-repl-depth 0)) - (when (= 0 (cl-decf js--js-repl-depth)) - (with-current-buffer inferior-moz-buffer - (goto-char (point-max)) - (js--js-wait-for-eval-prompt) - (insert "EXIT") - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) js--js-prompt-regexp - js-js-timeout)))) - -(defsubst js--js-not (value) - (memq value '(nil null false undefined))) - -(defsubst js--js-true (value) - (not (js--js-not value))) - -(eval-and-compile - (defun js--optimize-arglist (arglist) - "Convert immediate js< and js! references to deferred ones." - (cl-loop for item in arglist - if (eq (car-safe item) 'js<) - collect (append (list 'list ''js--funcall - '(list 'interactor "_getProp")) - (js--optimize-arglist (cdr item))) - else if (eq (car-safe item) 'js>) - collect (append (list 'list ''js--funcall - '(list 'interactor "_putProp")) - - (if (atom (cadr item)) - (list (cadr item)) - (list - (append - (list 'list ''js--funcall - '(list 'interactor "_mkArray")) - (js--optimize-arglist (cadr item))))) - (js--optimize-arglist (cddr item))) - else if (eq (car-safe item) 'js!) - collect (pcase-let ((`(,_ ,function . ,body) item)) - (append (list 'list ''js--funcall - (if (consp function) - (cons 'list - (js--optimize-arglist function)) - function)) - (js--optimize-arglist body))) - else - collect item))) - -(defmacro js--js-get-service (class-name interface-name) - `(js! ("Components" "classes" ,class-name "getService") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro js--js-create-instance (class-name interface-name) - `(js! ("Components" "classes" ,class-name "createInstance") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro js--js-qi (object interface-name) - `(js! (,object "QueryInterface") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro with-js (&rest forms) - "Run FORMS with the Mozilla repl set up for js commands. -Inside the lexical scope of `with-js', `js?', `js!', -`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service', -`js-create-instance', and `js-qi' are defined." - (declare (indent 0) (debug t)) - `(progn - (js--js-enter-repl) - (unwind-protect - (cl-macrolet ((js? (&rest body) `(js--js-true ,@body)) - (js! (function &rest body) - `(js--js-funcall - ,(if (consp function) - (cons 'list - (js--optimize-arglist function)) - function) - ,@(js--optimize-arglist body))) - - (js-new (function &rest body) - `(js--js-new - ,(if (consp function) - (cons 'list - (js--optimize-arglist function)) - function) - ,@body)) - - (js-eval (thisobj js) - `(js--js-eval - ,@(js--optimize-arglist - (list thisobj js)))) - - (js-list (&rest args) - `(js--js-list - ,@(js--optimize-arglist args))) - - (js-get-service (&rest args) - `(js--js-get-service - ,@(js--optimize-arglist args))) - - (js-create-instance (&rest args) - `(js--js-create-instance - ,@(js--optimize-arglist args))) - - (js-qi (&rest args) - `(js--js-qi - ,@(js--optimize-arglist args))) - - (js< (&rest body) `(js--js-get - ,@(js--optimize-arglist body))) - (js> (props value) - `(js--js-funcall - '(interactor "_putProp") - ,(if (consp props) - (cons 'list - (js--optimize-arglist props)) - props) - ,@(js--optimize-arglist (list value)) - )) - (js-handle? (arg) `(js--js-handle-p ,arg))) - ,@forms) - (js--js-leave-repl)))) - -(defvar js--js-array-as-list nil - "Whether to listify any Array returned by a Mozilla function. -If nil, the whole Array is treated as a JS symbol.") - -(defun js--js-decode-retval (result) - (pcase (intern (cl-first result)) - ('atom (cl-second result)) - ('special (intern (cl-second result))) - ('array - (mapcar #'js--js-decode-retval (cl-second result))) - ('objid - (or (gethash (cl-second result) - js--js-references) - (puthash (cl-second result) - (make-js--js-handle - :id (cl-second result) - :process (inferior-moz-process)) - js--js-references))) - - ('error (signal 'js-js-error (list (cl-second result)))) - (x (error "Unmatched case in js--js-decode-retval: %S" x)))) - -(defvar comint-last-input-end) - -(defun js--js-funcall (function &rest arguments) - "Call the Mozilla function FUNCTION with arguments ARGUMENTS. -If function is a string, look it up as a property on the global -object and use the global object for `this'. -If FUNCTION is a list with one element, use that element as the -function with the global object for `this', except that if that -single element is a string, look it up on the global object. -If FUNCTION is a list with more than one argument, use the list -up to the last value as a property descriptor and the last -argument as a function." - - (with-js - (let ((argstr (js--js-encode-value - (cons function arguments)))) - - (with-current-buffer inferior-moz-buffer - ;; Actual funcall - (when js--js-array-as-list - (insert "*")) - (insert argstr) - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) "EVAL>" - js-js-timeout) - (goto-char comint-last-input-end) - - ;; Read the result - (let* ((json-array-type 'list) - (result (prog1 (json-read) - (goto-char (point-max))))) - (js--js-decode-retval result)))))) - -(defun js--js-new (constructor &rest arguments) - "Call CONSTRUCTOR as a constructor, with arguments ARGUMENTS. -CONSTRUCTOR is a JS handle, a string, or a list of these things." - (apply #'js--js-funcall - '(interactor "_callNew") - constructor arguments)) - -(defun js--js-eval (thisobj js) - (js--js-funcall '(interactor "_callEval") thisobj js)) - -(defun js--js-list (&rest arguments) - "Return a Lisp array resulting from evaluating each of ARGUMENTS." - (let ((js--js-array-as-list t)) - (apply #'js--js-funcall '(interactor "_mkArray") - arguments))) - -(defun js--js-get (&rest props) - (apply #'js--js-funcall '(interactor "_getProp") props)) - -(defun js--js-put (props value) - (js--js-funcall '(interactor "_putProp") props value)) - -(defun js-gc (&optional force) - "Tell the repl about any objects we don't reference anymore. -With argument, run even if no intervening GC has happened." - (interactive) - - (when force - (setq js--js-last-gcs-done nil)) - - (let ((this-gcs-done gcs-done) keys num) - (when (and js--js-references - (boundp 'inferior-moz-buffer) - (buffer-live-p inferior-moz-buffer) - - ;; Don't bother running unless we've had an intervening - ;; garbage collection; without a gc, nothing is deleted - ;; from the weak hash table, so it's pointless telling - ;; MozRepl about that references we still hold - (not (eq js--js-last-gcs-done this-gcs-done)) - - ;; Are we looking at a normal prompt? Make sure not to - ;; interrupt the user if he's doing something - (with-current-buffer inferior-moz-buffer - (save-excursion - (goto-char (point-max)) - (looking-back js--js-prompt-regexp - (save-excursion (forward-line 0) (point)))))) - - (setq keys (cl-loop for x being the hash-keys - of js--js-references - collect x)) - (setq num (js--js-funcall '(repl "_jsGC") (or keys []))) - - (setq js--js-last-gcs-done this-gcs-done) - (when (called-interactively-p 'interactive) - (message "Cleaned %s entries" num)) - - num))) - -(run-with-idle-timer 30 t #'js-gc) - -(defun js-eval (js) - "Evaluate the JavaScript in JS and return JSON-decoded result." - (interactive "MJavaScript to evaluate: ") - (with-js - (let* ((content-window (js--js-content-window - (js--get-js-context))) - (result (js-eval content-window js))) - (when (called-interactively-p 'interactive) - (message "%s" (js! "String" result))) - result))) - -(defun js--get-tabs () - "Enumerate all JavaScript contexts available. -Each context is a list: - (TITLE URL BROWSER TAB TABBROWSER) for content documents - (TITLE URL WINDOW) for windows - -All tabs of a given window are grouped together. The most recent -window is first. Within each window, the tabs are returned -left-to-right." - (with-js - (let (windows) - - (cl-loop with window-mediator = (js! ("Components" "classes" - "@mozilla.org/appshell/window-mediator;1" - "getService") - (js< "Components" "interfaces" - "nsIWindowMediator")) - with enumerator = (js! (window-mediator "getEnumerator") nil) - - while (js? (js! (enumerator "hasMoreElements"))) - for window = (js! (enumerator "getNext")) - for window-info = (js-list window - (js< window "document" "title") - (js! (window "location" "toString")) - (js< window "closed") - (js< window "windowState")) - - unless (or (js? (cl-fourth window-info)) - (eq (cl-fifth window-info) 2)) - do (push window-info windows)) - - (cl-loop for (window title location) in windows - collect (list title location window) - - for gbrowser = (js< window "gBrowser") - if (js-handle? gbrowser) - nconc (cl-loop - for x below (js< gbrowser "browsers" "length") - collect (js-list (js< gbrowser - "browsers" - x - "contentDocument" - "title") - - (js! (gbrowser - "browsers" - x - "contentWindow" - "location" - "toString")) - (js< gbrowser - "browsers" - x) - - (js! (gbrowser - "tabContainer" - "childNodes" - "item") - x) - - gbrowser)))))) - -(defvar js-read-tab-history nil) - -(declare-function ido-chop "ido" (items elem)) - -(defun js--read-tab (prompt) - "Read a Mozilla tab with prompt PROMPT. -Return a cons of (TYPE . OBJECT). TYPE is either `window' or -`tab', and OBJECT is a JavaScript handle to a ChromeWindow or a -browser, respectively." - - ;; Prime IDO - (unless ido-mode - (ido-mode 1) - (ido-mode -1)) - - (with-js - (let ((tabs (js--get-tabs)) selected-tab-cname - selected-tab prev-hitab) - - ;; Disambiguate names - (setq tabs - (cl-loop with tab-names = (make-hash-table :test 'equal) - for tab in tabs - for cname = (format "%s (%s)" - (cl-second tab) (cl-first tab)) - for num = (cl-incf (gethash cname tab-names -1)) - if (> num 0) - do (setq cname (format "%s <%d>" cname num)) - collect (cons cname tab))) - - (cl-labels - ((find-tab-by-cname - (cname) - (cl-loop for tab in tabs - if (equal (car tab) cname) - return (cdr tab))) - - (mogrify-highlighting - (hitab unhitab) - - ;; Hack to reduce the number of - ;; round-trips to mozilla - (let (cmds) - (cond - ;; Highlighting tab - ((cl-fourth hitab) - (push '(js! ((cl-fourth hitab) "setAttribute") - "style" - "color: red; font-weight: bold") - cmds) - - ;; Highlight window proper - (push '(js! ((cl-third hitab) - "setAttribute") - "style" - "border: 8px solid red") - cmds) - - ;; Select tab, when appropriate - (when js-js-switch-tabs - (push - '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab)) - cmds))) - - ;; Highlighting whole window - ((cl-third hitab) - (push '(js! ((cl-third hitab) "document" - "documentElement" "setAttribute") - "style" - (concat "-moz-appearance: none;" - "border: 8px solid red;")) - cmds))) - - (cond - ;; Unhighlighting tab - ((cl-fourth unhitab) - (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "") - cmds) - (push '(js! ((cl-third unhitab) "setAttribute") "style" "") - cmds)) - - ;; Unhighlighting window - ((cl-third unhitab) - (push '(js! ((cl-third unhitab) "document" - "documentElement" "setAttribute") - "style" "") - cmds))) - - (eval `(with-js - (js-list ,@(nreverse cmds))) - t))) - - (command-hook - () - (let* ((tab (find-tab-by-cname (car ido-matches)))) - (mogrify-highlighting tab prev-hitab) - (setq prev-hitab tab))) - - (setup-hook - () - ;; Fiddle with the match list a bit: if our first match - ;; is a tabbrowser window, rotate the match list until - ;; the active tab comes up - (let ((matched-tab (find-tab-by-cname (car ido-matches)))) - (when (and matched-tab - (null (cl-fourth matched-tab)) - (equal "navigator:browser" - (js! ((cl-third matched-tab) - "document" - "documentElement" - "getAttribute") - "windowtype"))) - - (cl-loop with tab-to-match = (js< (cl-third matched-tab) - "gBrowser" - "selectedTab") - - for match in ido-matches - for candidate-tab = (find-tab-by-cname match) - if (eq (cl-fourth candidate-tab) tab-to-match) - do (setq ido-cur-list - (ido-chop ido-cur-list match)) - and return t))) - - (add-hook 'post-command-hook #'command-hook t t))) - - - (unwind-protect - ;; FIXME: Don't impose IDO on the user. - (setq selected-tab-cname - (let ((ido-minibuffer-setup-hook - (cons #'setup-hook ido-minibuffer-setup-hook))) - (ido-completing-read - prompt - (mapcar #'car tabs) - nil t nil - 'js-read-tab-history))) - - (when prev-hitab - (mogrify-highlighting nil prev-hitab) - (setq prev-hitab nil))) - - (add-to-history 'js-read-tab-history selected-tab-cname) - - (setq selected-tab (cl-loop for tab in tabs - if (equal (car tab) selected-tab-cname) - return (cdr tab))) - - (cons (if (cl-fourth selected-tab) 'browser 'window) - (cl-third selected-tab)))))) - -(defun js--guess-eval-defun-info (pstate) - "Helper function for `js-eval-defun'. -Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of -strings making up the class name and NAME is the name of the -function part." - (cond ((and (= (length pstate) 3) - (eq (js--pitem-type (cl-first pstate)) 'function) - (= (length (js--pitem-name (cl-first pstate))) 1) - (consp (js--pitem-type (cl-second pstate)))) - - (append (js--pitem-name (cl-second pstate)) - (list (cl-first (js--pitem-name (cl-first pstate)))))) - - ((and (= (length pstate) 2) - (eq (js--pitem-type (cl-first pstate)) 'function)) - - (append - (butlast (js--pitem-name (cl-first pstate))) - (list (car (last (js--pitem-name (cl-first pstate))))))) - - (t (error "Function not a toplevel defun or class member")))) - -(defvar js--js-context nil - "The current JavaScript context. -This is a cons like the one returned from `js--read-tab'. -Change with `js-set-js-context'.") - -(defconst js--js-inserter - "(function(func_info,func) { - func_info.unshift('window'); - var obj = window; - for(var i = 1; i < func_info.length - 1; ++i) { - var next = obj[func_info[i]]; - if(typeof next !== 'object' && typeof next !== 'function') { - next = obj.prototype && obj.prototype[func_info[i]]; - if(typeof next !== 'object' && typeof next !== 'function') { - alert('Could not find ' + func_info.slice(0, i+1).join('.') + - ' or ' + func_info.slice(0, i+1).join('.') + '.prototype'); - return; - } - - func_info.splice(i+1, 0, 'prototype'); - ++i; - } - } - - obj[func_info[i]] = func; - alert('Successfully updated '+func_info.join('.')); - })") - -(defun js-set-js-context (context) - "Set the JavaScript context to CONTEXT. -When called interactively, prompt for CONTEXT." - (interactive (list (js--read-tab "JavaScript Context: "))) - (setq js--js-context context)) - -(defun js--get-js-context () - "Return a valid JavaScript context. -If one hasn't been set, or if it's stale, prompt for a new one." - (with-js - (when (or (null js--js-context) - (js--js-handle-expired-p (cdr js--js-context)) - (pcase (car js--js-context) - ('window (js? (js< (cdr js--js-context) "closed"))) - ('browser (not (js? (js< (cdr js--js-context) - "contentDocument")))) - (x (error "Unmatched case in js--get-js-context: %S" x)))) - (setq js--js-context (js--read-tab "JavaScript Context: "))) - js--js-context)) - -(defun js--js-content-window (context) - (with-js - (pcase (car context) - ('window (cdr context)) - ('browser (js< (cdr context) - "contentWindow" "wrappedJSObject")) - (x (error "Unmatched case in js--js-content-window: %S" x))))) - -(defun js--make-nsilocalfile (path) - (with-js - (let ((file (js-create-instance "@mozilla.org/file/local;1" - "nsILocalFile"))) - (js! (file "initWithPath") path) - file))) - -(defun js--js-add-resource-alias (alias path) - (with-js - (let* ((io-service (js-get-service "@mozilla.org/network/io-service;1" - "nsIIOService")) - (res-prot (js! (io-service "getProtocolHandler") "resource")) - (res-prot (js-qi res-prot "nsIResProtocolHandler")) - (path-file (js--make-nsilocalfile path)) - (path-uri (js! (io-service "newFileURI") path-file))) - (js! (res-prot "setSubstitution") alias path-uri)))) - -(cl-defun js-eval-defun () - "Update a Mozilla tab using the JavaScript defun at point." - (interactive) - - ;; This function works by generating a temporary file that contains - ;; the function we'd like to insert. We then use the elisp-js bridge - ;; to command mozilla to load this file by inserting a script tag - ;; into the document we set. This way, debuggers and such will have - ;; a way to find the source of the just-inserted function. - ;; - ;; We delete the temporary file if there's an error, but otherwise - ;; we add an unload event listener on the Mozilla side to delete the - ;; file. - - (save-excursion - (let (begin end pstate defun-info temp-name defun-body) - (js-end-of-defun) - (setq end (point)) - (js--ensure-cache) - (js-beginning-of-defun) - (re-search-forward "\\_<function\\_>") - (setq begin (match-beginning 0)) - (setq pstate (js--forward-pstate)) - - (when (or (null pstate) - (> (point) end)) - (error "Could not locate function definition")) - - (setq defun-info (js--guess-eval-defun-info pstate)) - - (let ((overlay (make-overlay begin end))) - (overlay-put overlay 'face 'highlight) - (unwind-protect - (unless (y-or-n-p (format "Send %s to Mozilla? " - (mapconcat #'identity defun-info "."))) - (message "") ; question message lingers until next command - (cl-return-from js-eval-defun)) - (delete-overlay overlay))) - - (setq defun-body (buffer-substring-no-properties begin end)) - - (make-directory js-js-tmpdir t) - - ;; (Re)register a Mozilla resource URL to point to the - ;; temporary directory - (js--js-add-resource-alias "js" js-js-tmpdir) - - (setq temp-name (make-temp-file (concat js-js-tmpdir - "/js-") - nil ".js")) - (unwind-protect - (with-js - (with-temp-buffer - (insert js--js-inserter) - (insert "(") - (let ((standard-output (current-buffer))) - (json--print-list defun-info)) - (insert ",\n") - (insert defun-body) - (insert "\n)") - (write-region (point-min) (point-max) temp-name - nil 1)) - - ;; Give Mozilla responsibility for deleting this file - (let* ((content-window (js--js-content-window - (js--get-js-context))) - (content-document (js< content-window "document")) - (head (if (js? (js< content-document "body")) - ;; Regular content - (js< (js! (content-document "getElementsByTagName") - "head") - 0) - ;; Chrome - (js< content-document "documentElement"))) - (elem (js! (content-document "createElementNS") - "http://www.w3.org/1999/xhtml" "script"))) - - (js! (elem "setAttribute") "type" "text/javascript") - (js! (elem "setAttribute") "src" - (format "resource://js/%s" - (file-name-nondirectory temp-name))) - - (js! (head "appendChild") elem) - - (js! (content-window "addEventListener") "unload" - (js! ((js-new - "Function" "file" - "return function() { file.remove(false) }")) - (js--make-nsilocalfile temp-name)) - 'false) - (setq temp-name nil) - - - - )) - - ;; temp-name is set to nil on success - (when temp-name - (delete-file temp-name)))))) - ;;; Syntax extensions (defvar js-syntactic-mode-name t diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 6bf070cf9e5..79530f81673 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1814,18 +1814,18 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first." (user-error "Aborted"))) (_ name))) -(defvar find-tag-marker-ring) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun octave-find-definition (fn) "Find the definition of FN. Functions implemented in C++ can be found if variable `octave-source-directories' is set correctly." (interactive (list (octave-completing-read))) - (require 'etags) + (require 'xref) (let ((orig (point))) (if (and (derived-mode-p 'octave-mode) (octave-goto-function-definition fn)) - (ring-insert find-tag-marker-ring (copy-marker orig)) + (xref-push-marker-stack (copy-marker orig)) (inferior-octave-send-list-and-digest ;; help NAME is more verbose (list (format "\ @@ -1840,7 +1840,7 @@ if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" (setq file (match-string 1 line)))) (if (not file) (user-error "%s" (or line (format-message "`%s' not found" fn))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (setq file (funcall octave-find-definition-filename-function file)) (when file (find-file file) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index e6e6e40aa19..5938da542ac 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1357,9 +1357,7 @@ The default is a name found in the buffer around point." default "")) (label ;; Do completion with default. - (completing-read (if (not (string= default "")) - (concat "Label (default " default "): ") - "Label: ") + (completing-read (format-prompt "Label" default) ;; Complete with the defuns found in the ;; current-buffer. (let ((buf (current-buffer))) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index e43f2ff90b5..496b0810183 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -49,9 +49,15 @@ (define-key-after menu [prog-separator] menu-bar-separator 'middle-separator) + (unless (xref-forward-history-empty-p) + (define-key-after menu [xref-forward] + '(menu-item "Go Forward" xref-go-forward + :help "Forward to the position gone Back from") + 'prog-separator)) + (unless (xref-marker-stack-empty-p) (define-key-after menu [xref-pop] - '(menu-item "Go Back" xref-pop-marker-stack + '(menu-item "Go Back" xref-go-back :help "Back to the position of the last search") 'prog-separator)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da7435cddf3..c2e125a017a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -322,7 +322,15 @@ to find the list of ignores for each directory." (process-file-shell-command command nil t)) (pt (point-min))) (unless (zerop status) - (error "File listing failed: %s" (buffer-string))) + (goto-char (point-min)) + (if (and + (not (eql status 127)) + (search-forward "Permission denied\n" nil t)) + (let ((end (1- (point)))) + (re-search-backward "\\`\\|\0") + (error "File listing failed: %s" + (buffer-substring (1+ (point)) end))) + (error "File listing failed: %s" (buffer-string)))) (goto-char pt) (while (search-forward "\0" nil t) (push (buffer-substring-no-properties (1+ pt) (1- (point))) @@ -840,28 +848,36 @@ pattern to search for." project-regexp-history-variable))) ;;;###autoload -(defun project-find-file () +(defun project-find-file (&optional include-all) "Visit a file (with completion) in the current project. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (list (project-root pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) ;;;###autoload -(defun project-or-external-find-file () +(defun project-or-external-find-file (&optional include-all) "Visit a file (with completion) in the current project or external roots. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (cons (project-root pr) (project-external-roots pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) (defcustom project-read-file-name-function #'project--read-file-cpd-relative "Function to call to read a file name from a list. @@ -914,12 +930,25 @@ by the user at will." predicate hist mb-default)) -(defun project-find-file-in (suggested-filename dirs project) +(defun project-find-file-in (suggested-filename dirs project &optional include-all) "Complete a file name in DIRS in PROJECT and visit the result. SUGGESTED-FILENAME is a relative file name, or part of it, which -is used as part of \"future history\"." - (let* ((all-files (project-files project dirs)) +is used as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files from DIRS, except for VCS +directories listed in `vc-directory-exclusion-list'." + (let* ((vc-dirs-ignores (mapcar + (lambda (dir) + (concat dir "/")) + vc-directory-exclusion-list)) + (all-files + (if include-all + (mapcan + (lambda (dir) (project--files-in-directory dir vc-dirs-ignores)) + dirs) + (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 @@ -1181,6 +1210,15 @@ current project, it will be killed." :group 'project :package-version '(project . "0.6.0")) +(defcustom project-kill-buffers-display-buffer-list nil + "Non-nil to display list of buffers to kill before killing project buffers. +Used by `project-kill-buffers'." + :type 'boolean + :version "29.1" + :group 'project + :package-version '(project . "0.8.1") + :safe #'booleanp) + (defun project--buffer-list (pr) "Return the list of all buffers in project PR." (let ((conn (file-remote-p (project-root pr))) @@ -1247,14 +1285,35 @@ NO-CONFIRM is always nil when the command is invoked interactively." (interactive) (let* ((pr (project-current t)) - (bufs (project--buffers-to-kill pr))) + (bufs (project--buffers-to-kill pr)) + (query-user (lambda () + (yes-or-no-p + (format "Kill %d buffers in %s? " + (length bufs) + (project-root 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))) + (project-kill-buffers-display-buffer-list + (when + (with-current-buffer-window + (get-buffer-create "*Buffer List*") + `(display-buffer--maybe-at-bottom + (dedicated . t) + (window-height . (fit-window-to-buffer)) + (preserve-size . (nil . t)) + (body-function + . ,#'(lambda (_window) + (list-buffers-noselect nil bufs)))) + #'(lambda (window _value) + (with-selected-window window + (unwind-protect + (funcall query-user) + (when (window-live-p window) + (quit-restore-window window 'kill)))))) + (mapc #'kill-buffer bufs))) + ((funcall query-user) (mapc #'kill-buffer bufs))))) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 59004e413eb..c36082bb6d0 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2484,11 +2484,8 @@ Interaction supports completion." (if (eq (try-completion default prolog-info-alist) nil) (setq default nil)) ;; Read the PredSpec from the user - (completing-read - (if (zerop (length default)) - "Help on predicate: " - (concat "Help on predicate (default " default "): ")) - prolog-info-alist nil t nil nil default))) + (completing-read (format-prompt "Help on predicate" default) + prolog-info-alist nil t nil nil default))) (defun prolog-build-info-alist (&optional verbose) "Build an alist of all builtins and library predicates. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1c3e75bb73..47d8d1ce8ec 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.2") (cl-lib "1.0")) +;; Package-Requires: ((emacs "24.4") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -1427,6 +1427,13 @@ marks the next defun after the ones already marked." ;;; Navigation +(defcustom python-forward-sexp-function #'python-nav-forward-sexp + "Function to use when navigating between expressions." + :version "28.1" + :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) + (const :tag "CC-mode like" nil) + function)) + (defvar python-nav-beginning-of-defun-regexp (python-rx line-start (* space) defun (+ space) (group symbol-name)) "Regexp matching class or function definition. @@ -1518,7 +1525,10 @@ Returns nil if point is not in a def or class." (python-util-forward-comment -1) (forward-line 1) ;; Ensure point moves forward. - (and (> beg-pos (point)) (goto-char beg-pos))))) + (and (> beg-pos (point)) (goto-char beg-pos)) + ;; Return non-nil if we did something (because then we were in a + ;; def/class). + (/= beg-pos (point))))) (defun python-nav--syntactically (fn poscompfn &optional contextfn) "Move point using FN avoiding places with specific context. @@ -2724,20 +2734,12 @@ goes wrong and syntax highlighting in the shell gets messed up." (deactivate-mark nil) (start-pos prompt-end) (buffer-undo-list t) - (font-lock-buffer-pos nil) (replacement (python-shell-font-lock-with-font-lock-buffer - (delete-region (line-beginning-position) - (point-max)) - (setq font-lock-buffer-pos (point)) + (delete-region (point-min) (point-max)) (insert input) - ;; Ensure buffer is fontified, keeping it - ;; compatible with Emacs < 24.4. - (if (fboundp 'font-lock-ensure) - (funcall 'font-lock-ensure) - (font-lock-default-fontify-buffer)) - (buffer-substring font-lock-buffer-pos - (point-max)))) + (font-lock-ensure) + (buffer-string))) (replacement-length (length replacement)) (i 0)) ;; Inject text properties to get input fontified. @@ -3763,7 +3765,8 @@ With argument MSG show activation/deactivation message." (format "was t and %S is not part of the " (file-name-nondirectory python-shell-interpreter)) "`python-shell-completion-native-disabled-interpreters' " - "list. Native completions have been disabled locally. ")) + "list. Native completions have been disabled locally. " + "Consider installing the python package \"readline\". ")) (python-shell-completion-native-turn-off msg)))))) (defun python-shell-completion-native-turn-on-maybe-with-msg () @@ -3810,7 +3813,7 @@ With argument MSG show activation/deactivation message." (comint-redirect-perform-sanity-check nil) (comint-redirect-insert-matching-regexp t) (comint-redirect-finished-regexp - "1__dummy_completion__[[:space:]]*\n") + "1__dummy_completion__.*\n") (comint-redirect-output-buffer redirect-buffer)) ;; Compatibility with Emacs 24.x. Comint changed and ;; now `comint-redirect-filter' gets 3 args. This @@ -4670,7 +4673,10 @@ See `python-check-command' for the default." target = obj objtype = 'def' if target: - args = inspect.formatargspec(*argspec_function(target)) + if hasattr(inspect, 'signature'): + args = str(inspect.signature(target)) + else: + args = inspect.formatargspec(*argspec_function(target)) name = obj.__name__ doc = '{objtype} {name}{args}'.format( objtype=objtype, name=name, args=args @@ -4769,10 +4775,14 @@ 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: ") - nil nil symbol)))) + (list (read-string + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt "Describe symbol" symbol) + (if symbol + (format "Describe symbol (default %s): " symbol) + "Describe symbol: ")) + nil nil symbol)))) (message (python-eldoc--get-doc-at-point symbol))) (defun python-describe-at-point (symbol process) @@ -5569,13 +5579,6 @@ By default messages are considered errors." :type '(alist :key-type (regexp) :value-type (symbol))) -(defcustom python-forward-sexp-function #'python-nav-forward-sexp - "Function to use when navigating between expressions." - :version "28.1" - :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) - (const :tag "CC-mode like" nil) - function)) - (defvar-local python--flymake-proc nil) (defun python--flymake-parse-output (source proc report-fn) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 57351a7308d..abcdcb3349e 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -143,7 +143,6 @@ (setq-local comment-start-skip ";+[ \t]*") (setq-local comment-use-syntax t) (setq-local comment-column 40) - (setq-local parse-sexp-ignore-comments t) (setq-local lisp-indent-function 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) (setq-local imenu-case-fold-search t) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0dd9f2b4fa2..c6b6f83471d 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -628,7 +628,8 @@ removed when closing the here document." (wksh sh-append ksh88) (zsh sh-append ksh88 - "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" + "autoload" "always" + "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" "disable" "disown" "echotc" "enable" "functions" "getln" "hash" "history" "integer" "limit" "local" "log" "popd" "pushd" "r" "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 5dfbf87e452..f5888a0ce7a 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -481,9 +481,9 @@ file. Since that is a plaintext file, this could be dangerous." :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") :completion-object sql-postgres-completion-object - :prompt-regexp "^[[:alnum:]_]*=[#>] " + :prompt-regexp "^[-[:alnum:]_]*[-=][#>] " :prompt-length 5 - :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " + :prompt-cont-regexp "^[-[:alnum:]_]*[-'(][#>] " :statement sql-postgres-statement-starters :input-filter sql-remove-tabs-filter :terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g")) @@ -700,8 +700,17 @@ making new SQLi sessions." (sexp :tag "Value Expression"))))) :version "24.1") -(defvaralias 'sql-dialect 'sql-product) +(defun sql-add-connection (connection params) + "Add a new connection to `sql-connection-alist'. +If CONNECTION already exists, it is replaced with PARAMS." + (setq sql-connection-alist + (assoc-delete-all connection sql-connection-alist)) + (push + (cons connection params) + sql-connection-alist)) + +(defvaralias 'sql-dialect 'sql-product) (defcustom sql-product 'ansi "Select the SQL database product used. This allows highlighting buffers properly when you open them." @@ -963,12 +972,7 @@ If set to \"\\n\", each line in the history file will be interpreted as one command. Multi-line commands are split into several commands when the input ring is initialized from a history file. -This variable used to initialize `comint-input-ring-separator'. -`comint-input-ring-separator' is part of Emacs 21; if your Emacs -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\"." +This variable used to initialize `comint-input-ring-separator'." :type 'string) ;; The usual hooks @@ -1357,8 +1361,6 @@ specified, it's `sql-product' or `sql-connection' must match." (defvar sql-interactive-mode-map (let ((map (make-sparse-keymap))) (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) (define-key map (kbd "C-c C-w") 'sql-copy-column) (define-key map (kbd "O") 'sql-magic-go) @@ -2832,16 +2834,6 @@ configured." (font-lock-mode-internal nil) (font-lock-mode-internal t)) - (add-hook 'font-lock-mode-hook - (lambda () - ;; Provide defaults for new font-lock faces. - (defvar font-lock-builtin-face - (if (boundp 'font-lock-preprocessor-face) - font-lock-preprocessor-face - font-lock-keyword-face)) - (defvar font-lock-doc-face font-lock-string-face)) - nil t) - ;; Setup imenu; it needs the same syntax-alist. (when imenu (setq imenu-syntax-alist syntax-alist)))) @@ -3219,14 +3211,7 @@ For both `:file' and `:completion', there can also be a symbol (let* ((default (plist-get plist :default)) (last-value (sql-default-value symbol)) - (prompt-def - (if default - (if (string-match "\\(\\):[ \t]*\\'" prompt) - (replace-match (format " (default \"%s\")" default) t t prompt 1) - (replace-regexp-in-string "[ \t]*\\'" - (format " (default \"%s\") " default) - prompt t t)) - prompt)) + (prompt-def (format-prompt prompt default)) (use-dialog-box nil)) (cond ((plist-member plist :file) @@ -3311,7 +3296,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) ('user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) + (sql-get-login-ext 'sql-user "User" 'sql-user-history plist)) ('password (setq-default sql-password @@ -3330,14 +3315,14 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (read-passwd "Password: " nil (sql-default-value 'sql-password))))) ('server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port - (sql-get-login-ext 'sql-port "Port: " + (sql-get-login-ext 'sql-port "Port" nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) @@ -4182,10 +4167,6 @@ must tell Emacs. Here's how to do that in your init file: (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table - (when (and (featurep 'xemacs) - sql-mode-menu) - (easy-menu-add sql-mode-menu)) - ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (setq-local comment-start "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. @@ -4308,9 +4289,6 @@ you entered, right above the output it created. (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) - (when (and (featurep 'xemacs) - sql-interactive-mode-menu) - (easy-menu-add sql-interactive-mode-menu)) ;; 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 @@ -4681,6 +4659,14 @@ the call to \\[sql-product-interactive] with (get-buffer new-sqli-buffer))))) (user-error "No default SQL product defined: set `sql-product'"))) +(defun sql-comint-automatic-password (_) + "Intercept password prompts when we know the password. +This must also do the job of detecting password prompts." + (when (and + sql-password + (not (string= "" sql-password))) + sql-password)) + (defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. @@ -4705,6 +4691,13 @@ buffer. If nil, a name is chosen for it." (setq buf-name (sql-generate-unique-sqli-buffer-name product nil))) (set-text-properties 0 (length buf-name) nil buf-name) + ;; Create the buffer first, because we want to set it up before + ;; comint starts to run. + (set-buffer (get-buffer-create buf-name)) + ;; Set up the automatic population of passwords, if supported. + (when (sql-get-product-feature product :password-in-comint) + (setq comint-password-function #'sql-comint-automatic-password)) + ;; Start the command interpreter in the buffer ;; PROC-NAME is BUF-NAME without enclosing asterisks (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name))) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 52c34d9fbc6..14f252b42d4 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: 2021.09.23.089128420 +;; Version: 2021.10.14.127365406 ;; 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 "2021-09-23-54ffde4-vpo-GNU" +(defconst verilog-mode-version "2021-10-14-797711e-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.") @@ -1264,7 +1264,9 @@ See `verilog-auto-inst-param-value'." Also affects AUTOINSTPARAM. Declaration order is the default for backward compatibility, and as some teams prefer signals that are declared together to remain together. Sorted order reduces -changes when declarations are moved around in a file. +changes when declarations are moved around in a file. Sorting is +within input/output/inout groupings, there is intentionally no +option to intermix between input/output/inouts. See also `verilog-auto-arg-sort'." :version "24.1" ; rev688 @@ -5478,8 +5480,11 @@ becomes: (let* ((pop-up-windows t)) (let ((name (expand-file-name (read-file-name - (format "Find this error in: (default %s) " - file) + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt "Find this error in" file) + (format "Find this error in (default %s): " + file)) nil ;; dir file t)))) (setq buffer @@ -6598,7 +6603,8 @@ Also move point to constraint." (equal (char-before) ?\;) (equal (char-before) ?\})) ;; skip what looks like bus repetition operator {#{ - (not (string-match "^{\\s-*[\\(\\)0-9a-zA-Z_]*\\s-*{" (buffer-substring p (point))))))))) + (not (string-match "^{\\s-*[()0-9a-zA-Z_\\]*\\s-*{" + (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) @@ -7863,14 +7869,14 @@ If search fails, other files are checked based on (let* ((default (verilog-get-default-symbol)) ;; The following variable is used in verilog-comp-function (verilog-buffer-to-use (current-buffer)) - (label (if (not (string= default "")) - ;; Do completion with default - (completing-read (concat "Goto-Label: (default " - default ") ") - #'verilog-comp-defun nil nil "") - ;; There is no default value. Complete without it - (completing-read "Goto-Label: " - #'verilog-comp-defun nil nil ""))) + (label + (completing-read (cond ((fboundp 'format-prompt) + ;; `format-prompt' is new in Emacs 28.1. + (format-prompt "Goto-Label" default)) + ((not (string= default "")) + (concat "Goto-Label (default " default "): ")) + (t "Goto-Label: ")) + #'verilog-comp-defun nil nil "")) pt) ;; Make sure library paths are correct, in case need to resolve module (verilog-auto-reeval-locals) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 3a9185b334f..f3a7d96c63b 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -10683,8 +10683,9 @@ Include a library specification, if not already there." (replace-match "" t t) (vhdl-template-insert-date)) (goto-char beg) - (while (search-forward "<year>" end t) - (replace-match (format-time-string "%Y" nil) t t)) + (let ((year (format-time-string "%Y"))) + (while (search-forward "<year>" end t) + (replace-match year t t))) (goto-char beg) (when file-title (while (search-forward "<title string>" end t) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 492be9a104d..ca3594d253b 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. -;; Version: 1.3.0 +;; Version: 1.3.2 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -75,7 +75,7 @@ (require 'project) (eval-and-compile - (when (version< emacs-version "28") + (when (version< emacs-version "28.0.60") ;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type ;; inherits from `xref-location'. (require 'eieio) @@ -195,16 +195,23 @@ is not known." ;;; Cross-reference -(cl-defstruct (xref-item - (:constructor xref-make (summary location)) - (:noinline t)) +(defmacro xref--defstruct (name &rest fields) + (declare (indent 1)) + `(cl-defstruct ,(if (>= emacs-major-version 27) + name + (remq (assq :noinline name) name)) + ,@fields)) + +(xref--defstruct (xref-item + (:constructor xref-make (summary location)) + (:noinline t)) "An xref item describes a reference to a location somewhere." summary location) -(cl-defstruct (xref-match-item - (:include xref-item) - (:constructor xref-make-match (summary location length)) - (:noinline t)) +(xref--defstruct (xref-match-item + (:include xref-item) + (:constructor xref-make-match (summary location length)) + (:noinline t)) "A match xref item describes a search result." length) @@ -334,15 +341,9 @@ backward." (t (goto-char start) nil)))) -;;; Marker stack (M-. pushes, M-, pops) - -(defcustom xref-marker-ring-length 16 - "Length of the xref marker ring. -If this variable is not set through Customize, you must call -`xref-set-marker-ring-length' for changes to take effect." - :type 'integer - :initialize #'custom-initialize-default - :set #'xref-set-marker-ring-length) +;; Dummy variable retained for compatibility. +(defvar xref-marker-ring-length 16) +(make-obsolete-variable 'xref-marker-ring-length nil "29.1") (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -413,29 +414,59 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(defvar xref--marker-ring (make-ring xref-marker-ring-length) - "Ring of markers to implement the marker stack.") +(make-obsolete-variable 'xref-marker-ring nil "29.1") + +(defun xref-set-marker-ring-length (_var _val) + (declare (obsolete nil "29.1")) + nil) + +(defvar xref--history (cons nil nil) + "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") -(defun xref-set-marker-ring-length (var val) - "Set `xref-marker-ring-length'. -VAR is the symbol `xref-marker-ring-length' and VAL is the new -value." - (set-default var val) - (if (ring-p xref--marker-ring) - (ring-resize xref--marker-ring val))) +(defun xref--push-backward (m) + "Push marker M onto the backward history stack." + (unless (equal m (caar xref--history)) + (push m (car xref--history)))) + +(defun xref--push-forward (m) + "Push marker M onto the forward history stack." + (unless (equal m (cadr xref--history)) + (push m (cdr xref--history)))) (defun xref-push-marker-stack (&optional m) - "Add point M (defaults to `point-marker') to the marker stack." - (ring-insert xref--marker-ring (or m (point-marker)))) + "Add point M (defaults to `point-marker') to the marker stack. +The future stack is erased." + (xref--push-backward (or m (point-marker))) + (dolist (mk (cdr xref--history)) + (set-marker mk nil nil)) + (setcdr xref--history nil)) + +;;;###autoload +(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") + +;;;###autoload +(defun xref-go-back () + "Go back to the previous position in xref history. +To undo, use \\[xref-go-forward]." + (interactive) + (if (null (car xref--history)) + (user-error "At start of xref history") + (let ((marker (pop (car xref--history)))) + (xref--push-forward (point-marker)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook)))) ;;;###autoload -(defun xref-pop-marker-stack () - "Pop back to where \\[xref-find-definitions] was last invoked." +(defun xref-go-forward () + "Got to the point where a previous \\[xref-go-back] was invoked." (interactive) - (let ((ring xref--marker-ring)) - (when (ring-empty-p ring) - (user-error "Marker stack is empty")) - (let ((marker (ring-remove ring 0))) + (if (null (cdr xref--history)) + (user-error "At end of xref history") + (let ((marker (pop (cdr xref--history)))) + (xref--push-backward (point-marker)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) @@ -458,17 +489,23 @@ value." ;; etags.el needs this (defun xref-clear-marker-stack () - "Discard all markers from the marker stack." - (let ((ring xref--marker-ring)) - (while (not (ring-empty-p ring)) - (let ((marker (ring-remove ring))) - (set-marker marker nil nil))))) + "Discard all markers from the xref history." + (dolist (l (list (car xref--history) (cdr xref--history))) + (dolist (m l) + (set-marker m nil nil))) + (setq xref--history (cons nil nil)) + nil) ;;;###autoload (defun xref-marker-stack-empty-p () - "Return t if the marker stack is empty; nil otherwise." - (ring-empty-p xref--marker-ring)) + "Whether the xref back-history is empty." + (null (car xref--history))) +;; FIXME: rename this to `xref-back-history-empty-p'. +;;;###autoload +(defun xref-forward-history-empty-p () + "Whether the xref forward-history is empty." + (null (cdr xref--history))) (defun xref--goto-char (pos) @@ -683,7 +720,7 @@ quit the *xref* buffer." "Quit *xref* buffer, then pop the xref marker stack." (interactive) (quit-window) - (xref-pop-marker-stack)) + (xref-go-back)) (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -1322,12 +1359,17 @@ definitions." (xref--prompt-p this-command)) (let ((id (completing-read - (if def - (format "%s (default %s): " - (substring prompt 0 (string-match - "[ :]+\\'" prompt)) - def) - prompt) + ;; `format-prompt' is new in Emacs 28.1 + (if (fboundp 'format-prompt) + (format-prompt (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + (if def + (format "%s (default %s): " + (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + prompt)) (xref-backend-identifier-completion-table backend) nil nil nil 'xref--read-identifier-history def))) @@ -1388,7 +1430,7 @@ definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a buffer where the user can select from the list. -Use \\[xref-pop-marker-stack] to return back to where you invoked this command." +Use \\[xref-go-back] to return back to where you invoked this command." (interactive (list (xref--read-identifier "Find definitions of: "))) (xref--find-definitions identifier nil)) @@ -1479,7 +1521,8 @@ output of this command when the backend is etags." ;;; Key bindings ;;;###autoload (define-key esc-map "." #'xref-find-definitions) -;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) +;;;###autoload (define-key esc-map "," #'xref-go-back) +;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key esc-map "?" #'xref-find-references) ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) |