Commit 4786618f authored by Paul Eggert's avatar Paul Eggert

Top-level elisp files respect ‘text-quoting-style’

In top-level elisp files, use format-message in diagnostic formats,
so that they follow user preference as per ‘text-quoting-style’
rather than being hard-coded to quote `like this'.
* lisp/allout.el (allout-get-configvar-values):
* lisp/apropos.el (apropos-symbols-internal):
* lisp/dired-aux.el (dired-do-shell-command, dired-create-files)
(dired-do-create-files-regexp, dired-create-files-non-directory):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log, dired-dnd-handle-local-file):
* lisp/disp-table.el (standard-display-european):
* lisp/find-dired.el (find-dired):
* lisp/forms.el (forms-mode):
* lisp/ido.el (ido-buffer-internal):
* lisp/info.el (Info-index-next):
* lisp/outline.el (outline-invent-heading):
* lisp/printing.el (pr-ps-outfile-preprint, pr-i-ps-send):
* lisp/proced.el (proced-log):
* lisp/ps-print.el (ps-print-preprint, ps-get-size):
* lisp/recentf.el (recentf-open-files, recentf-save-list):
* lisp/savehist.el (savehist-save):
* lisp/server.el (server-ensure-safe-dir):
* lisp/ses.el (ses-rename-cell):
* lisp/simple.el (list-processes--refresh):
* lisp/startup.el (command-line):
* lisp/strokes.el (strokes-unset-last-stroke)
(strokes-execute-stroke):
Use format-message so that quotes are restyled.
* lisp/cus-edit.el (custom-raised-buttons, customize-browse):
Don’t quote ‘raised’.
* lisp/descr-text.el (describe-char):
* lisp/dirtrack.el (dirtrack-debug-message):
* lisp/hexl.el (hexl-insert-multibyte-char):
Apply substitute-command-keys to help string.
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
Let dired-log do the formatting.
parent b12cfbfd
......@@ -6490,8 +6490,9 @@ not its value."
got)
(dolist (sym configvar-value)
(if (not (boundp sym))
(if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
configvar-name sym))
(if (yes-or-no-p (format-message
"%s entry `%s' is unbound -- remove it? "
configvar-name sym))
(delq sym (symbol-value configvar-name)))
(push (symbol-value sym) got)))
(reverse got)))
......
......@@ -727,11 +727,10 @@ the output includes key-bindings of commands."
(let ((alias (get symbol 'face-alias)))
(if alias
(if (facep alias)
(format "%slias for the face `%s'."
(if (get symbol 'obsolete-face)
"Obsolete a"
"A")
alias)
(format-message
"%slias for the face `%s'."
(if (get symbol 'obsolete-face) "Obsolete a" "A")
alias)
;; Never happens in practice because fails
;; (facep symbol) test.
"(alias for undefined face)")
......
......@@ -1599,7 +1599,7 @@ This button will have a menu with all three reset operations."
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
"If non-nil, indicate active buttons in a `raised-button' style.
"If non-nil, indicate active buttons in a raised-button style.
Otherwise use brackets."
:type 'boolean
:version "21.1"
......@@ -1748,7 +1748,7 @@ Operate on all settings in this buffer:\n"))
on a button to invoke its action.
Invoke [+] to expand a group, and [-] to collapse an expanded group.\n"
(if custom-raised-buttons
"`Raised' text indicates"
"Raised text indicates"
"Square brackets indicate")))
......
......@@ -799,7 +799,8 @@ relevant to POS."
(insert "\n " (car elt) ":"
(propertize " " 'display '(space :align-to 4))
(or (cdr elt) "-- not encodable --"))))
(insert "\nSee the variable `reference-point-alist' for "
(insert (substitute-command-keys
"\nSee the variable `reference-point-alist' for ")
"the meaning of the rule.\n")))
(unless eight-bit-p
......
......@@ -686,9 +686,11 @@ can be produced by `dired-get-marked-files', for example."
(if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
((and star on-each)
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
(y-or-n-p (format-message
"Confirm--do you mean to use `*' as a wildcard? ")))
((and qmark no-subst)
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
(y-or-n-p (format-message
"Confirm--do you mean to use `?' as a wildcard? ")))
(t))
(if on-each
(dired-bunch-files
......@@ -1497,7 +1499,7 @@ or with the current marker character if MARKER-CHAR is t."
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
(let ((help-form '(format "\
(let ((help-form '(format-message "\
Type SPC or `y' to overwrite file `%s',
DEL or `n' to skip to next,
ESC or `q' to not overwrite any of the remaining files,
......@@ -1878,11 +1880,11 @@ of `dired-dwim-target', which see."
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
(operation-prompt (concat operation " `%s' to `%s'?"))
(rename-regexp-help-form (format "\
(rename-regexp-help-form (format-message "\
Type SPC or `y' to %s one match, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
(downcase operation)
(downcase operation)))
(downcase operation)
(downcase operation)))
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
......@@ -2003,11 +2005,11 @@ See function `dired-do-rename-regexp' for more info."
(let ((to (concat (file-name-directory from)
(funcall basename-constructor
(file-name-nondirectory from)))))
(and (let ((help-form (format "\
(and (let ((help-form (format-message "\
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
(downcase operation)
(downcase operation))))
(downcase operation)
(downcase operation))))
(dired-query 'rename-non-directory-query
(concat operation " `%s' to `%s'")
(dired-make-relative from)
......
......@@ -1353,12 +1353,12 @@ otherwise."
(interactive)
(let ((file (dired-get-filename t)))
(if dired-bind-vm
(if (y-or-n-p (concat "Visit `" file
"' as a mail folder with VM?"))
(if (y-or-n-p (format-message
"Visit %s as a mail folder with VM?" file))
(dired-vm))
;; Read mail folder using rmail.
(if (y-or-n-p (concat "Visit `" file
"' as a mailbox with RMAIL?"))
(if (y-or-n-p (format-message
"Visit %s as a mailbox with RMAIL?" file))
(dired-rmail)))))
......
......@@ -3558,7 +3558,7 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
(let ((inhibit-read-only t))
(cond ((stringp log)
(insert (if args
(apply (function format) log args)
(apply #'format-message log args)
log)))
((bufferp log)
(insert-buffer-substring log))
......@@ -3811,7 +3811,8 @@ Ask means pop up a menu for the user to select one of copy, move or link."
((memq action '(copy private move link))
(let ((overwrite (and (file-exists-p to)
(y-or-n-p
(format "Overwrite existing file `%s'? " to))))
(format-message
"Overwrite existing file `%s'? " to))))
;; Binding dired-overwrite-confirmed to nil makes
;; dired-handle-overwrite a no-op. We instead use
;; y-or-n-p, which pops a graphical menu.
......@@ -3824,7 +3825,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(car (find-backup-file-name to)))
(or (eq dired-backup-overwrite 'always)
(y-or-n-p
(format
(format-message
"Make backup for existing file `%s'? " to))))
(rename-file to backup-file 0)
(dired-relist-entry backup-file))
......
......@@ -218,7 +218,7 @@ the mode if ARG is omitted or nil."
(when dirtrack-debug-mode
(with-current-buffer (get-buffer-create dirtrack-debug-buffer)
(goto-char (point-max))
(insert msg1 msg2 "\n"))))
(insert (substitute-command-keys msg1) msg2 "\n"))))
(declare-function shell-prefixed-directory-name "shell" (dir))
(declare-function shell-process-cd "shell" (arg))
......
......@@ -281,7 +281,8 @@ in `.emacs'."
(set-terminal-coding-system nil))))
(display-warning 'i18n
"`standard-display-european' is semi-obsolete; see its doc string for details"
(format-message
"`standard-display-european' is semi-obsolete; see its doc string for details")
:warning)
;; Switch to Latin-1 language environment
......
......@@ -151,7 +151,8 @@ use in place of \"-ls\" as the final argument."
(let ((find (get-buffer-process (current-buffer))))
(when find
(if (or (not (eq (process-status find) 'run))
(yes-or-no-p "A `find' process is running; kill it? "))
(yes-or-no-p
(format-message "A `find' process is running; kill it? ")))
(condition-case nil
(progn
(interrupt-process find)
......
......@@ -692,10 +692,12 @@ Commands: Equivalent keys in read-only mode:
(insert
"GNU Emacs Forms Mode\n\n"
(if (file-exists-p forms-file)
(concat "No records available in file `" forms-file "'\n\n")
(format "Creating new file `%s'\nwith %d field%s per record\n\n"
forms-file forms-number-of-fields
(if (= 1 forms-number-of-fields) "" "s")))
(format-message
"No records available in file `%s'\n\n" forms-file)
(format-message
"Creating new file `%s'\nwith %d field%s per record\n\n"
forms-file forms-number-of-fields
(if (= 1 forms-number-of-fields) "" "s")))
"Use " (substitute-command-keys "\\[forms-insert-record]")
" to create new records.\n")
(setq forms--current-record 1)
......
......@@ -940,8 +940,9 @@ and their encoded form is inserted byte by byte."
ch internal-hex))
(setq encoded internal)
(error
"Can't encode `0x%x' with this buffer's coding system; try \\[hexl-insert-hex-string]"
ch)))
"Can't encode `0x%x' with this buffer's coding system; %s"
ch
(substitute-command-keys "try \\[hexl-insert-hex-string]"))))
(while (> num 0)
(mapc
(function (lambda (c) (hexl-insert-char c 1))) encoded)
......
......@@ -2275,7 +2275,8 @@ If cursor is not at the end of the user input, move to end of input."
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
(not (y-or-n-p (format "No buffer matching `%s', create one? " buf))))
(not (y-or-n-p (format-message
"No buffer matching `%s', create one? " buf))))
nil)
;; buffer doesn't exist
......@@ -2285,7 +2286,8 @@ If cursor is not at the end of the user input, move to end of input."
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
(not (y-or-n-p (format "No buffer matching `%s', create one? " buf))))
(not (y-or-n-p (format-message
"No buffer matching `%s', create one? " buf))))
nil)
;; create a new buffer
......
......@@ -3381,11 +3381,11 @@ Give an empty topic name to go to the Index node itself."
(car (car Info-index-alternatives))
(nth 2 (car Info-index-alternatives))
(if (cdr Info-index-alternatives)
(format "(%s total; use `%s' for next)"
(length Info-index-alternatives)
(key-description (where-is-internal
'Info-index-next overriding-local-map
t)))
(format-message
"(%s total; use `%s' for next)"
(length Info-index-alternatives)
(key-description (where-is-internal
'Info-index-next overriding-local-map t)))
"(Only match)")))
(defun Info-find-index-name (name)
......
......@@ -449,8 +449,8 @@ Otherwise, it will be one level below."
;; Why bother checking that it is indeed higher/lower level ?
new-head
;; Didn't work, so ask what to do.
(read-string (format "%s heading for `%s': "
(if up "Parent" "Demoted") head)
(read-string (format-message "%s heading for `%s': "
(if up "Parent" "Demoted") head)
head nil nil t)))))
(defun outline-promote (&optional which)
......
......@@ -5542,8 +5542,8 @@ If menu binding was not done, calls `pr-menu-bind'."
((file-exists-p res)
(ding)
(setq prompt "exists")
(not (y-or-n-p (format "File `%s' exists; overwrite? "
res))))
(not (y-or-n-p (format-message
"File `%s' exists; overwrite? " res))))
(t nil))
(setq res (read-file-name
(format "File %s; PostScript file: " prompt)
......@@ -6540,8 +6540,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
((or (not (file-exists-p pr-i-out-file))
pr-i-answer-yes
(setq pr-i-answer-yes
(y-or-n-p (format "File `%s' exists; overwrite? "
pr-i-out-file))))
(y-or-n-p (format-message "File `%s' exists; overwrite? "
pr-i-out-file))))
pr-i-out-file)
(t
(error "File already exists"))))
......
......@@ -1924,8 +1924,8 @@ and \f (formfeed) at the end."
(unless (bolp)
(insert "\n"))
(insert (current-time-string)
"\tBuffer `" (buffer-name obuf) "', "
(format "signal `%s'\n" (car args)))
(format-message "\tBuffer ‘%s’, signal ‘%s’\n"
(buffer-name obuf) (car args)))
(goto-char (point-max))
(insert "\f\n")))))))
......
......@@ -4604,8 +4604,8 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(setq prompt "File is unwritable"))
((file-exists-p res)
(setq prompt "File exists")
(not (y-or-n-p (format "File `%s' exists; overwrite? "
res))))
(not (y-or-n-p (format-message
"File `%s' exists; overwrite? " res))))
(t nil))
(setq res (read-file-name
(format "%s; save PostScript to file: " prompt)
......@@ -5711,7 +5711,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(error "Invalid %s `%S'%s"
mess size
(if arg
(format " for `%S'" arg)
(format-message " for `%S'" arg)
"")))
siz))
......
......@@ -1224,7 +1224,7 @@ use for the dialog. It defaults to \"*`recentf-menu-title'*\"."
", or type the corresponding digit key,"
"")
" to open it.\n"
"Click on Cancel or type `q' to cancel.\n")
(format-message "Click on Cancel or type ‘q’ to cancel.\n"))
;; Use a L&F that looks like the recentf menu.
(tree-widget-set-theme "folder")
(apply 'widget-create
......@@ -1281,7 +1281,8 @@ Write data into the file specified by `recentf-save-file'."
(with-temp-buffer
(erase-buffer)
(set-buffer-file-coding-system recentf-save-file-coding-system)
(insert (format recentf-save-file-header (current-time-string)))
(insert (format-message recentf-save-file-header
(current-time-string)))
(recentf-dump-variable 'recentf-list recentf-max-saved-items)
(recentf-dump-variable 'recentf-filter-changer-current)
(insert "\n \n;; Local Variables:\n"
......
......@@ -270,8 +270,12 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
(interactive)
(with-temp-buffer
(insert
(format ";; -*- mode: emacs-lisp; coding: %s -*-\n" savehist-coding-system)
";; Minibuffer history file, automatically generated by `savehist'.\n\n")
(format-message
(concat
";; -*- mode: emacs-lisp; coding: %s -*-\n"
";; Minibuffer history file, automatically generated by `savehist'.\n"
"\n")
savehist-coding-system))
(run-hooks 'savehist-save-hook)
(let ((print-length nil)
(print-string-length nil)
......
......@@ -533,7 +533,8 @@ Creates the directory if necessary and makes sure:
((and w32 (zerop uid)) ; on FAT32?
(display-warning
'server
(format "Using `%s' to store Emacs-server authentication files.
(format-message "\
Using `%s' to store Emacs-server authentication files.
Directories on FAT32 filesystems are NOT secure against tampering.
See variable `server-auth-dir' for details."
(file-name-as-directory dir))
......
......@@ -3360,8 +3360,10 @@ highlighted range in the spreadsheet."
(ses-is-cell-sym-p new-name)
(error "Already a cell name"))
(and (boundp new-name)
(null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
new-name)))
(null (yes-or-no-p
(format-message
"`%S' is already bound outside this buffer, continue? "
new-name)))
(error "Already a bound cell name")))
(let* (curcell
(sym (if (ses-cell-p cell)
......
......@@ -3565,8 +3565,9 @@ Also, delete any process that is exited or signaled."
(buf-label (if (buffer-live-p buf)
`(,(buffer-name buf)
face link
help-echo ,(concat "Visit buffer `"
(buffer-name buf) "'")
help-echo ,(format-message
"Visit buffer %s"
(buffer-name buf))
follow-link t
process-buffer ,buf
action process-menu-visit-buffer)
......
......@@ -1115,8 +1115,9 @@ please check its value")
"~/.emacs")
((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
;; Also support _emacs for compatibility, but warn about it.
(push '(initialization
"`_emacs' init file is deprecated, please use `.emacs'")
(push `(initialization
,(format-message
"`_emacs' init file is deprecated, please use `.emacs'"))
delayed-warnings-list)
"~/_emacs")
(t ;; But default to .emacs if _emacs does not exist.
......
......@@ -423,8 +423,9 @@ or for window START-WINDOW if that is specified."
(interactive)
(let ((command (cdar strokes-global-map)))
(if (y-or-n-p
(format "Really delete last stroke definition, defined to `%s'? "
command))
(format-message
"Really delete last stroke definition, defined to `%s'? "
command))
(progn
(setq strokes-global-map (cdr strokes-global-map))
(message "That stroke has been deleted"))
......@@ -868,8 +869,8 @@ If no stroke matches, nothing is done and return value is nil."
((null strokes-global-map)
(if (file-exists-p strokes-file)
(and (y-or-n-p
(format "No strokes loaded. Load `%s'? "
strokes-file))
(format-message "No strokes loaded. Load `%s'? "
strokes-file))
(strokes-load-user-strokes))
(error "No strokes defined; use `strokes-global-set-stroke'")))
(t
......
......@@ -494,8 +494,8 @@ non-nil means return old filename."
overwrite))
(error
(setq errors (1+ errors))
(dired-log (concat "Rename `" file-ori "' to `"
file-new "' failed:\n%s\n")
(dired-log "Rename %s to %s failed:\n%s\n"
file-ori file-new
err)))))))))
errors))
......@@ -651,8 +651,8 @@ If OLD, return the old target. If MOVE, move point before it."
(substitute-in-file-name link-to-new) link-from))
(error
(setq errors (1+ errors))
(dired-log (concat "Link `" link-from "' to `"
link-to-new "' failed:\n%s\n")
(dired-log "Link ‘%s’ to ‘%s’ failed:\n%s\n"
link-from link-to-new
err)))))
(cons changes errors)))
......@@ -837,11 +837,11 @@ Like original function but it skips read-only words."
(unless (equal 0 (process-file dired-chmod-program
nil nil nil perm-tmp filename))
(setq errors (1+ errors))
(dired-log (concat dired-chmod-program " " perm-tmp
" `" filename "' failed\n\n"))))
(dired-log "%s %s ‘%s’ failed\n\n"
dired-chmod-program perm-tmp filename)))
(setq errors (1+ errors))
(dired-log (concat "Cannot parse permission `" perms-new
"' for file `" filename "'\n\n"))))
(dired-log "Cannot parse permission ‘%s’ for file ‘%s’\n\n"
perms-new filename)))
(goto-char (next-single-property-change (1+ (point)) prop-wanted
nil (point-max))))
(cons changes errors)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment