summaryrefslogtreecommitdiff
path: root/lisp/progmodes
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/progmodes')
-rw-r--r--lisp/progmodes/bug-reference.el8
-rw-r--r--lisp/progmodes/cc-vars.el2
-rw-r--r--lisp/progmodes/compile.el1
-rw-r--r--lisp/progmodes/cpp.el7
-rw-r--r--lisp/progmodes/ebrowse.el6
-rw-r--r--lisp/progmodes/erts-mode.el201
-rw-r--r--lisp/progmodes/etags.el4
-rw-r--r--lisp/progmodes/gdb-mi.el11
-rw-r--r--lisp/progmodes/grep.el8
-rw-r--r--lisp/progmodes/gud.el4
-rw-r--r--lisp/progmodes/hideif.el2
-rw-r--r--lisp/progmodes/js.el1138
-rw-r--r--lisp/progmodes/pascal.el4
-rw-r--r--lisp/progmodes/project.el53
-rw-r--r--lisp/progmodes/prolog.el7
-rw-r--r--lisp/progmodes/python.el33
-rw-r--r--lisp/progmodes/sql.el43
-rw-r--r--lisp/progmodes/verilog-mode.el34
-rw-r--r--lisp/progmodes/xref.el17
19 files changed, 338 insertions, 1245 deletions
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index fd014a38d95..c6327c1a3f3 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -269,7 +269,7 @@ 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 "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
"\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
,(lambda (groups)
@@ -284,7 +284,7 @@ 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_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>"
@@ -301,7 +301,7 @@ 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_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
@@ -322,7 +322,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-vars.el b/lisp/progmodes/cc-vars.el
index d843c783ed0..83fd3da7c1d 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
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index ac26f5e9341..14da5880203 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2228,6 +2228,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/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..6e416d064a8 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)
diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el
new file mode 100644
index 00000000000..9d51c1f8f08
--- /dev/null
+++ b/lisp/progmodes/erts-mode.el
@@ -0,0 +1,201 @@
+;;; 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-run-test (test-function)
+ "Run the current test.
+If the current erts file doesn't define a test function, the user
+will be prompted for one."
+ (interactive
+ (list (save-excursion
+ ;; Find the preceding Code spec.
+ (while (and (re-search-backward "^Code:" nil t)
+ (erts-mode--in-test-p (point))))
+ (if (and (not (erts-mode--in-test-p (point)))
+ (re-search-forward "^=-=$" nil t))
+ (progn
+ (goto-char (match-beginning 0))
+ (cdr (assq 'code (ert--erts-specifications (point)))))
+ (read-string "Transformation function: "))))
+ 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))))
+ (buffer-file-name))
+ (:success (message "Test successful"))
+ (ert-test-failed (message "Test failure; result: \n%s"
+ (substring-no-properties (cadr (cadr arg))))))))
+
+(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..d2ce813daae 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -292,7 +292,7 @@ file the tag was in."
(or (locate-dominating-file default-directory "TAGS")
default-directory)))
(list (read-file-name
- "Visit tags table (default TAGS): "
+ (format-prompt "Visit tags table" "TAGS")
;; default to TAGS from default-directory up to root.
default-tag-dir
(expand-file-name "TAGS" default-tag-dir)
@@ -625,7 +625,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(car list))
;; Finally, prompt the user for a file name.
(expand-file-name
- (read-file-name "Visit tags table (default TAGS): "
+ (read-file-name (format-prompt "Visit tags table" "TAGS")
default-directory
"TAGS"
t))))))
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index fa54f511608..39fcfd341cb 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -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 ec2850737c8..001989e39ad 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..9b884c4ff80 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3539,8 +3539,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/js.el b/lisp/progmodes/js.el
index 845ca8609d7..f6603f86d5f 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
@@ -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'.")
@@ -3336,1106 +3318,6 @@ current buffer. Pushes a mark onto the tag ring just like
(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/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/project.el b/lisp/progmodes/project.el
index da7435cddf3..ed076a683d1 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
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 1b55db09503..49b8a865efc 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
@@ -2724,20 +2724,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.
@@ -4668,7 +4660,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
@@ -4767,10 +4762,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)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 5dfbf87e452..f55115e9027 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -963,12 +963,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 +1352,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 +2825,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 +3202,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 +3287,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 +3306,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 +4158,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 +4280,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
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/xref.el b/lisp/progmodes/xref.el
index 46922a3f3b9..52a4e0c5435 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1322,12 +1322,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)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-12 00:44:10 +0000