More-conservative ‘format’ quote restyling

Instead of restyling curved quotes for every call to ‘format’,
create a new function ‘format-message’ that does the restyling,
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
* doc/lispref/elisp.texi:
* doc/lispref/help.texi (Keys in Documentation):
* doc/lispref/minibuf.texi (Minibuffer Misc):
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Document the changes.
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/apropos.el (apropos-library):
* lisp/calc/calc-ext.el (calc-record-message)
(calc-user-function-list):
* lisp/calc/calc-help.el (calc-describe-key, calc-full-help):
* lisp/calc/calc-lang.el (math-read-big-balance):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--add-diary-entry):
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-completion-message):
* lisp/cedet/semantic/edit.el (semantic-parse-changes-failed):
* lisp/cedet/semantic/wisent/comp.el (wisent-log):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dframe.el (dframe-message):
* lisp/dired-aux.el (dired-query):
* lisp/emacs-lisp/byte-opt.el (byte-compile-log-lap-1):
* lisp/emacs-lisp/bytecomp.el (byte-compile-log)
(byte-compile-log-file, byte-compile-warn, byte-compile-form):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv-analyze-form):
* lisp/emacs-lisp/check-declare.el (check-declare-warn):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet):
* lisp/emacs-lisp/edebug.el (edebug-format):
* lisp/emacs-lisp/eieio-core.el (eieio-oref):
* lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message)
(eldoc-message):
* lisp/emacs-lisp/elint.el (elint-file, elint-log):
* lisp/emacs-lisp/find-func.el (find-function-library):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/emacs-lisp/package.el (package-compute-transaction)
(package-install-button-action, package-delete-button-action)
(package-menu--list-to-prompt):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emacs-lisp/warnings.el (lwarn, warn):
* lisp/emulation/viper-cmd.el:
(viper-toggle-parse-sexp-ignore-comments)
(viper-kill-buffer, viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/facemenu.el (facemenu-add-new-face):
* lisp/faces.el (face-documentation, read-face-name)
(face-read-string, read-face-font, describe-face):
* lisp/files.el (find-alternate-file, hack-local-variables)
(hack-one-local-variable--obsolete, write-file)
(basic-save-buffer, delete-directory):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--obsolete)
(help-fns--interactive-only, describe-function-1)
(describe-variable):
* lisp/help.el (describe-mode):
* lisp/info-xref.el (info-xref-output):
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
* lisp/international/kkc.el (kkc-error):
* lisp/international/mule-cmds.el:
(select-safe-coding-system-interactively)
(select-safe-coding-system, describe-input-method):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/international/quail.el (quail-error):
* lisp/minibuffer.el (minibuffer-message):
* lisp/mpc.el (mpc--debug):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-message):
* lisp/net/gnutls.el (gnutls-message-maybe):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/nsm.el (nsm-query-user):
* lisp/net/rlogin.el (rlogin):
* lisp/net/soap-client.el (soap-warning):
* lisp/net/tramp.el (tramp-debug-message):
* lisp/nxml/nxml-outln.el (nxml-report-outline-error):
* lisp/nxml/nxml-parse.el (nxml-parse-error):
* lisp/nxml/rng-cmpct.el (rng-c-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/org/org-ctags.el:
(org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/proced.el (proced-log):
* lisp/progmodes/ebnf2ps.el (ebnf-log):
* lisp/progmodes/flymake.el (flymake-log):
* lisp/progmodes/vhdl-mode.el (vhdl-warning-when-idle):
* lisp/replace.el (occur-1):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, define-alternatives):
* lisp/startup.el (command-line):
* lisp/subr.el (error, user-error, add-to-list):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* src/callint.c (Fcall_interactively):
* src/editfns.c (Fmessage, Fmessage_box):
Restyle the quotes of format strings intended for use as a
diagnostic, when restyling seems appropriate.
* lisp/subr.el (format-message): New function.
* src/doc.c (Finternal__text_restyle): New function.
(syms_of_doc): Define it.
This commit is contained in:
Paul Eggert 2015-08-23 22:38:02 -07:00
parent a5fd059f72
commit fbb5531fa1
87 changed files with 390 additions and 292 deletions

View file

@ -211,7 +211,7 @@ argument.
The prompt string can use @samp{%} to include previous argument values
(starting with the first argument) in the prompt. This is done using
@code{format} (@pxref{Formatting Strings}). For example, here is how
@code{format-message} (@pxref{Formatting Strings}). For example, here is how
you could read the name of an existing buffer followed by a new name to
give to that buffer:

View file

@ -990,7 +990,7 @@ should not end with any sort of punctuation.
@defun error format-string &rest args
This function signals an error with an error message constructed by
applying @code{format} (@pxref{Formatting Strings}) to
applying @code{format-message} (@pxref{Formatting Strings}) to
@var{format-string} and @var{args}.
These examples show typical uses of @code{error}:
@ -1009,7 +1009,7 @@ These examples show typical uses of @code{error}:
@code{error} works by calling @code{signal} with two arguments: the
error symbol @code{error}, and a list containing the string returned by
@code{format}.
@code{format-message}.
@strong{Warning:} If you want to use your own string as an error message
verbatim, don't just write @code{(error @var{string})}. If @var{string}

View file

@ -247,7 +247,7 @@ messages in the echo area.
@defun message format-string &rest arguments
This function displays a message in the echo area.
@var{format-string} is a format string, and @var{arguments} are the
objects for its format specifications, like in the @code{format}
objects for its format specifications, like in the @code{format-message}
function (@pxref{Formatting Strings}). The resulting formatted string
is displayed in the echo area; if it contains @code{face} text
properties, it is displayed with the specified faces (@pxref{Faces}).
@ -375,7 +375,7 @@ reporting very fast.
When this progress reporter is subsequently used, it will display
@var{message} in the echo area, followed by progress percentage.
@var{message} is treated as a simple string. If you need it to depend
on a filename, for instance, use @code{format} before calling this
on a filename, for instance, use @code{format-message} before calling this
function.
The arguments @var{min-value} and @var{max-value} should be numbers

View file

@ -375,6 +375,7 @@ Strings and Characters
* Text Comparison:: Comparing characters or strings.
* String Conversion:: Converting to and from characters and strings.
* Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}.
* Text Restyling:: Text style conversion function.
* Case Conversion:: Case conversion functions.
* Case Tables:: Customizing case conversion.

View file

@ -350,8 +350,7 @@ string in Emacs Lisp.
@defvar text-quoting-style
@cindex curved quotes
@cindex curly quotes
The value of this variable specifies the style
@code{substitute-command-keys} uses when generating left and right
The value of this variable specifies the style used to generate text
quotes. If the variable's value is @code{curve}, the style is
@t{like this} with curved single quotes. If the value is
@code{straight}, the style is @t{'like this'} with straight

View file

@ -2413,7 +2413,7 @@ arrives, whichever comes first. The variable
@code{minibuffer-message-timeout} specifies the number of seconds to
wait in the absence of input. It defaults to 2. If @var{args} is
non-@code{nil}, the actual message is obtained by passing @var{string}
and @var{args} through @code{format}. @xref{Formatting Strings}.
and @var{args} through @code{format-message}. @xref{Formatting Strings}.
@end defun
@deffn Command minibuffer-inactive-mode

View file

@ -801,7 +801,7 @@ they appear; it is called a @dfn{format string}.
Formatting is often useful for computing messages to be displayed. In
fact, the functions @code{message} and @code{error} provide the same
formatting feature described here; they differ from @code{format} only
formatting feature described here; they differ from @code{format-message} only
in how they use the result of formatting.
@defun format string &rest objects
@ -815,6 +815,12 @@ are copied directly into the output, including their text properties,
if any.
@end defun
@defun format-message string &rest objects
This function acts like @code{format}, except it also converts any
curved quotes in @var{string} as per the value of
@code{text-quoting-style}. @xref{Keys in Documentation}.
@end defun
@cindex @samp{%} in format
@cindex format specification
A format specification is a sequence of characters beginning with a

View file

@ -916,6 +916,12 @@ value of text-quoting-style. Doc strings in source code can use
either curved quotes or grave accent and apostrophe. As before,
isolated apostrophes and characters preceded by \= are output as-is.
+++
** Message-issuing functions error, message, etc. now convert quotes.
They use the new format-message function instead of plain format,
so that they now follow user preference as per text-quoting-style if
their format argument contains curved quotes.
+++
** The character classes [:alpha:] and [:alnum:] in regular expressions
now match multibyte characters using Unicode character properties.
@ -1038,6 +1044,10 @@ key works) by typing A-[ and A-]. As described above under
text-quoting-style, the user can specify how to display doc string
quotes.
+++
** New function format-message is like format and also converts
curved quotes as per text-quoting-style.
+++
** New format flag q
The new q flag causes format to quote the output representation as

View file

@ -399,7 +399,7 @@ A prefix argument means don't query; expand all abbrevs."
(buffer-substring-no-properties
(save-excursion (forward-word -1) (point))
pnt)))
(if (or noquery (y-or-n-p (format "Expand %s? " string)))
(if (or noquery (y-or-n-p (format-message "Expand %s? " string)))
(expand-abbrev)))))))
;;; Abbrev properties.

View file

@ -681,8 +681,8 @@ the output includes key-bindings of commands."
(apropos-symbols-internal
symbols apropos-do-all
(concat
(format (substitute-command-keys
"Library `%s' provides: %s\nand requires: %s")
(format-message
"Library %s provides: %s\nand requires: %s"
file
(mapconcat 'apropos-library-button
(or provides '(nil)) " and ")

View file

@ -1245,7 +1245,7 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-record-message (tag &rest args)
(let ((msg (apply 'format args)))
(let ((msg (apply #'format-message args)))
(message "%s" msg)
(calc-record msg tag))
(calc-clear-command-flag 'clear-message))
@ -1957,7 +1957,7 @@ calc-kill calc-kill-region calc-yank))))
(desc
(if (symbolp func)
(if (= (logand kind 3) 0)
(format "%c = %s" key name)
(format-message "%c = %s" key name)
(if pos
(format "%s%c%s"
(downcase (substring name 0 pos))

View file

@ -239,7 +239,7 @@ C-w Describe how there is no warranty for Calc."
(setq prompts (substring prompts 0 (match-beginning 0))))
(if (string-match "\\` +" prompts)
(setq prompts (substring prompts (match-end 0))))
(setq msg (format
(setq msg (format-message
"%s: %s%s%s%s%s %s%s"
(if (string-match
"\\`\\(calc-[-a-zA-Z0-9]+\\) *\\(.*\\)\\'"
@ -400,8 +400,9 @@ C-w Describe how there is no warranty for Calc."
(princ "GNU Emacs Calculator.\n")
(princ " By Dave Gillespie.\n")
(princ (format " %s\n\n" emacs-copyright))
(princ (format "Type h s for a more detailed summary.\n"))
(princ (format "Or type h i to read the full Calc manual on-line.\n\n"))
(princ (format-message "Type h s for a more detailed summary.\n"))
(princ (format-message
"Or type h i to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
(mapc (function (lambda (x) (princ (format
@ -415,10 +416,10 @@ C-w Describe how there is no warranty for Calc."
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
(format
(format-message
"\nv or V prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
(format
(format-message
"\n%c prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)

View file

@ -2508,7 +2508,8 @@ order to Calc's."
(while (> count 0)
(if (>= h len)
(if what
(math-read-big-error nil v (format "Unmatched %s" what))
(math-read-big-error nil v (format-message
"Unmatched %s" what))
(setq count 0))
(if (memq (aref line h) '(?\( ?\[))
(setq count (1+ count))

View file

@ -442,7 +442,8 @@
(setq calc-last-edited-variable var)
(calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
t
(format "Editing variable %s" (calc-var-name var)))
(format-message
"Editing variable %s" (calc-var-name var)))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))

View file

@ -1622,7 +1622,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(while (eq (car (car (setq uptr (cdr uptr)))) 0)))
(insert "\n\n")
(insert
(format
(format-message
(concat
"(**) When in TeX or LaTeX display mode, the TeX specific unit\n"
"names will not use the tex prefix; the unit name for a\n"

View file

@ -603,9 +603,9 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
(format "Press C-c C-c")
(format-message "Press C-c C-c")
(if allow-ret "" " or RET")
(format " to finish, C-x k RET to cancel.\n\n"))
(format-message " to finish, C-x k RET to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
(make-local-variable 'calc-edit-top)
(setq calc-edit-top (point))))

View file

@ -1118,10 +1118,10 @@ FExport diary data into iCalendar file: ")
(setq found-error t)
(save-current-buffer
(set-buffer (get-buffer-create "*icalendar-errors*"))
(insert (format "Error in line %d -- %s: %s\n"
(count-lines (point-min) (point))
error-val
entry-main))))))
(insert (format-message "Error in line %d -- %s: %s\n"
(count-lines (point-min) (point))
error-val
entry-main))))))
;; we're done, insert everything into the file
(save-current-buffer
@ -2473,8 +2473,8 @@ SUMMARY is not nil it must be a string that gives the summary of the
entry. In this case the user will be asked whether he wants to insert
the entry."
(when (or (not summary)
(y-or-n-p (format "Add appointment for %s to diary? "
summary)))
(y-or-n-p (format-message "Add appointment for %s to diary? "
summary)))
(when summary
(setq non-marking
(y-or-n-p (format "Make appointment non-marking? "))))

View file

@ -629,10 +629,9 @@ SYMBOL is a function that can be overridden."
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."
(let ((value (symbol-value symbol)))
(princ (format (substitute-command-keys "\n %s value is\n ")
symbol))
(princ (format-message "\n %s value is\n " symbol))
(if (and value (symbolp value))
(princ (format (substitute-command-keys "%s") value))
(princ (format-message "%s" value))
(let ((pt (point)))
(pp value)
(save-excursion
@ -690,7 +689,7 @@ SYMBOL is a function that can be overridden."
)
((symbolp buffer-or-mode)
(setq mode buffer-or-mode)
(princ (format (substitute-command-keys "%s\n") buffer-or-mode))
(princ (format-message "%s\n" buffer-or-mode))
)
((signal 'wrong-type-argument
(list 'buffer-or-mode buffer-or-mode))))
@ -700,7 +699,7 @@ SYMBOL is a function that can be overridden."
(while mode
(setq table (get mode 'mode-local-symbol-table))
(when table
(princ (format (substitute-command-keys "\n- From %s\n") mode))
(princ (format-message "\n- From %s\n" mode))
(mode-local-print-bindings table))
(setq mode (get-mode-local-parent mode)))))

View file

@ -156,7 +156,7 @@ Presumably if you call this you will insert something new there."
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
(apply 'message fmt args)
(message (concat (buffer-string) (apply 'format fmt args)))))
(message (concat (buffer-string) (apply #'format-message fmt args)))))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses

View file

@ -463,11 +463,11 @@ See `semantic-edits-change-leaf-tag' for details on parents."
(defun semantic-parse-changes-failed (&rest args)
"Signal that Semantic failed to parse changes.
That is, display a message by passing all ARGS to `format', then throw
That is, display a message by passing all ARGS to `format-message', then throw
a 'semantic-parse-changes-failed exception with value t."
(when semantic-edits-verbose-flag
(message "Semantic parse changes failed: %S"
(apply 'format args)))
(apply #'format-message args)))
(throw 'semantic-parse-changes-failed t))
(defsubst semantic-edits-incremental-fail ()

View file

@ -230,11 +230,11 @@ Its name is defined in constant `wisent-log-buffer-name'."
(defsubst wisent-log (&rest args)
"Insert text into the log buffer.
`format' is applied to ARGS and the result string is inserted into the
`format-message' is applied to ARGS and the result string is inserted into the
log buffer returned by the function `wisent-log-buffer'."
(and wisent-new-log-flag (wisent-new-log))
(with-current-buffer (wisent-log-buffer)
(insert (apply 'format args))))
(insert (apply #'format-message args))))
(defconst wisent-log-file "wisent.output"
"The log file.

View file

@ -216,7 +216,7 @@ insertions."
(data-debug-insert-thing dictionary "" "> ")
;; Show the error message.
(insert (propertize "Error" 'face '(:weight bold)) "\n")
(insert (apply #'format format args))
(insert (apply #'format-message format args))
(pop-to-buffer (current-buffer))))
(defun srecode-insert-report-error (dictionary format &rest args)

View file

@ -161,11 +161,8 @@ otherwise."
;; Buttons
(when (and button (not (widgetp wid-button)))
(newline)
(insert (substitute-command-keys "Here is a ")
(format "%S" button-type)
(substitute-command-keys " button labeled ")
button-label
(substitute-command-keys ".\n\n")))
(insert (format-message "Here is a %S button labeled %s.\n\n"
button-type button-label)))
;; Overlays
(when overlays
(newline)
@ -739,9 +736,7 @@ relevant to POS."
(when face
(insert (propertize " " 'display '(space :align-to 5))
"face: ")
(insert (substitute-command-keys "")
(symbol-name face)
(substitute-command-keys "\n"))))))
(insert (format-message "%s\n" face))))))
(insert "these terminal codes:\n")
(dotimes (i (length disp-vector))
(insert (car (aref disp-vector i))

View file

@ -688,11 +688,11 @@ Optionally select that frame if necessary."
Argument FMT is the format string, and ARGS are the arguments for message."
(save-selected-window
(if dframe-suppress-message-flag
(apply 'format fmt args)
(apply #'format-message fmt args)
(if dframe-attached-frame
;; KB: Here we do not need calling `dframe-select-attached-frame'
(select-frame dframe-attached-frame))
(apply 'message fmt args))))
(apply #'message fmt args))))
(defun dframe-y-or-n-p (prompt)
"Like `y-or-n-p', but for use in a dedicated frame.

View file

@ -1006,7 +1006,7 @@ return t; if SYM is q or ESC, return nil."
nil) ; skip, and don't ask again
(t ; no previous answer - ask now
(setq prompt
(concat (apply 'format prompt args)
(concat (apply #'format-message prompt args)
(if help-form
(format " [Type yn!q or %s] "
(key-description (vector help-char)))

View file

@ -192,7 +192,7 @@
;; (if (aref byte-code-vector 0)
;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
(byte-compile-log-1
(apply 'format format
(apply #'format-message format
(let (c a)
(mapcar (lambda (arg)
(if (not (consp arg))

View file

@ -973,7 +973,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(print-level 4)
(print-length 4))
(byte-compile-log-1
(format
(format-message
,format-string
,@(mapcar
(lambda (x) (if (symbolp x) (list 'prin1-to-string x) x))
@ -1120,7 +1120,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
pt)
(when dir
(unless was-same
(insert (format "Leaving directory %s\n" default-directory))))
(insert (format-message "Leaving directory %s\n"
default-directory))))
(unless (bolp)
(insert "\n"))
(setq pt (point-marker))
@ -1135,8 +1136,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when dir
(setq default-directory dir)
(unless was-same
(insert (format "Entering directory %s\n"
default-directory))))
(insert (format-message "Entering directory %s\n"
default-directory))))
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form nil)
;; Do this after setting default-directory.
@ -1154,7 +1155,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defun byte-compile-warn (format &rest args)
"Issue a byte compiler warning; use (format FORMAT ARGS...) for message."
(setq format (apply 'format format args))
(setq format (apply #'format-message format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
@ -2979,7 +2980,7 @@ for symbols generated by the byte compiler itself."
(`(',var . ,_)
(when (assq var byte-compile-lexical-variables)
(byte-compile-log-warning
(format "%s cannot use lexical var %s" fn var)
(format-message "%s cannot use lexical var %s" fn var)
nil :error)))))
(when (macroexp--const-symbol-p fn)
(byte-compile-warn "%s called as a function" fn))
@ -2991,8 +2992,8 @@ for symbols generated by the byte compiler itself."
(format "; %s" interactive-only))
((and (symbolp 'interactive-only)
(not (eq interactive-only t)))
(format "; use %s instead."
interactive-only))
(format-message "; use %s instead."
interactive-only))
(t "."))))
(if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-log-warning

View file

@ -300,7 +300,8 @@ places where they originally did not directly appear."
(prog1 binder (setq binder (list binder)))
(when (cddr binder)
(byte-compile-log-warning
(format "Malformed %S binding: %S" letsym binder)))
(format-message "Malformed %S binding: %S"
letsym binder)))
(setq value (cadr binder))
(car binder)))
(new-val
@ -545,7 +546,7 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
(byte-compile-log-warning
(format "%s %S not left unused" varkind var))))
(format-message "%s %S not left unused" varkind var))))
(pcase vardata
(`((,var . ,_) nil ,_ ,_ nil)
;; FIXME: This gives warnings in the wrong order, with imprecise line
@ -557,8 +558,8 @@ FORM is the parent form that binds this var."
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
(eq var 'ignored))
(byte-compile-log-warning (format "Unused lexical %s %S"
varkind var))))
(byte-compile-log-warning (format-message "Unused lexical %s %S"
varkind var))))
;; If it's unused, there's no point converting it into a cons-cell, even if
;; it's captured and mutated.
(`(,binder ,_ t t ,_)
@ -678,7 +679,7 @@ and updates the data stored in ENV."
;; ((and `(quote ,v . ,_) (guard (assq v env)))
;; (byte-compile-log-warning
;; (format "Possible confusion variable/symbol for %S" v)))
;; (format-message "Possible confusion variable/symbol for %S" v)))
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote

View file

@ -279,8 +279,8 @@ TYPE is a string giving the nature of the error. Warning is displayed in
entry))
(warning-fill-prefix " "))
(display-warning 'check-declare
(format "said %s was defined in %s: %s"
fn (file-name-nondirectory fnfile) type)
(format-message "said %s was defined in %s: %s"
fn (file-name-nondirectory fnfile) type)
nil check-declare-warning-buffer)))
(declare-function compilation-forget-errors "compile" ())

View file

@ -1714,7 +1714,7 @@ function,command,variable,option or symbol." ms1))))))
e t))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
(format
(format-message
"If this is the argument %s, it should appear as %s. Fix? "
(car args) (upcase (car args)))
(upcase (car args)) t)
@ -1740,7 +1740,7 @@ function,command,variable,option or symbol." ms1))))))
(insert "."))
nil)
(checkdoc-create-error
(format
(format-message
"Argument %s should appear (as %s) in the doc string"
(car args) (upcase (car args)))
s (marker-position e)))
@ -1824,16 +1824,16 @@ Replace with \"%s\"? " original replace)
(setq found (intern-soft ms))
(or (boundp found) (fboundp found)))
(progn
(setq msg (format "Add quotes around Lisp symbol %s? "
ms))
(setq msg (format-message
"Add quotes around Lisp symbol %s? " ms))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (+ (match-beginning 1)
(length ms))
msg (concat "" ms "") t)
(setq msg nil)
(setq msg
(format "Lisp symbol %s should appear in quotes"
ms))))))
(format-message
"Lisp symbol %s should appear in quotes" ms))))))
(if msg
(checkdoc-create-error msg (match-beginning 1)
(+ (match-beginning 1)

View file

@ -2101,8 +2101,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
macroexpand-all-environment))))
(if (or (null (cdar bindings)) (cl-cddar bindings))
(macroexp--warn-and-return
(format "Malformed cl-symbol-macrolet binding: %S"
(car bindings))
(format-message "Malformed cl-symbol-macrolet binding: %S"
(car bindings))
expansion)
expansion)))
(fset 'macroexpand previous-macroexpand))))))

View file

@ -3373,7 +3373,7 @@ Return the result of the last expression."
(defalias 'edebug-prin1 'prin1)
(defalias 'edebug-print 'print)
(defalias 'edebug-prin1-to-string 'prin1-to-string)
(defalias 'edebug-format 'format)
(defalias 'edebug-format 'format-message)
(defalias 'edebug-message 'message)
(defun edebug-eval-expression (expr)

View file

@ -733,7 +733,7 @@ Argument FN is the function calling this verifier."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp--warn-and-return
(format "Unknown slot %S" name) exp 'compile-only))
(format-message "Unknown slot %S" name) exp 'compile-only))
(_ exp)))))
(cl-check-type slot symbol)
(cl-check-type obj (or eieio-object class))

View file

@ -261,7 +261,7 @@ Otherwise work like `message'."
mode-line-format)))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply 'format format-string args)))
(apply #'format-message format-string args)))
(force-mode-line-update)))
(apply 'message format-string args)))
@ -274,7 +274,7 @@ Otherwise work like `message'."
;; eldoc-last-message so eq test above might succeed on
;; subsequent calls.
((null (cdr args)) (car args))
(t (apply 'format args))))
(t (apply #'format-message args))))
;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
;; are recorded in a log. Do not put eldoc messages in that log since
;; they are Legion.

View file

@ -249,9 +249,9 @@ This environment can be passed to `macroexpand'."
(elint-set-mode-line t)
(with-current-buffer elint-log-buffer
(unless (string-equal default-directory dir)
(elint-log-message (format " \nLeaving directory %s"
default-directory) t)
(elint-log-message (format "Entering directory %s" dir) t)
(elint-log-message (format-message " \nLeaving directory %s"
default-directory) t)
(elint-log-message (format-message "Entering directory %s" dir) t)
(setq default-directory dir))))
(let ((str (format "Linting file %s" file)))
(message "%s..." str)
@ -982,7 +982,7 @@ Does basic handling of `featurep' tests."
(line-beginning-position))))
0) ; unknown position
type
(apply 'format string args))))
(apply #'format-message string args))))
(defun elint-error (string &rest args)
"Report a linting error.

View file

@ -367,10 +367,11 @@ message about the whole chain of aliases."
(not verbose)
(setq aliases (if aliases
(concat aliases
(format ", which is an alias for %s"
(symbol-name def)))
(format "%s is an alias for %s"
function (symbol-name def)))))
(format-message
", which is an alias for %s"
(symbol-name def)))
(format-message "%s is an alias for %s"
function (symbol-name def)))))
(setq function (find-function-advised-original function)
def (find-function-advised-original function)))
(if aliases

View file

@ -146,11 +146,12 @@ and also to avoid outputting the warning during normal execution."
(defun macroexp--obsolete-warning (fun obsolescence-data type)
(let ((instead (car obsolescence-data))
(asof (nth 2 obsolescence-data)))
(format "%s is an obsolete %s%s%s" fun type
(if asof (concat " (as of " asof ")") "")
(cond ((stringp instead) (concat "; " instead))
(instead (format "; use %s instead." instead))
(t ".")))))
(format-message
"%s is an obsolete %s%s%s" fun type
(if asof (concat " (as of " asof ")") "")
(cond ((stringp instead) (concat "; " instead))
(instead (format-message "; use %s instead." instead))
(t ".")))))
(defun macroexpand-1 (form &optional environment)
"Perform (at most) one step of macroexpansion."

View file

@ -198,7 +198,8 @@ Returns the number of actions taken."
(objects (if help (nth 1 help) "objects"))
(action (if help (nth 2 help) "act on")))
(concat
(format "Type SPC or y to %s the current %s;
(format-message "\
Type SPC or y to %s the current %s;
DEL or n to skip the current %s;
RET or q to give up on the %s (skip all remaining %s);
C-g to quit (cancel the whole command);

View file

@ -95,7 +95,7 @@ Each element has the form (WHERE BYTECODE STACK) where:
(propertize (format "%s advice: " where)
'face 'warning)
(let ((fun (advice--car flist)))
(if (symbolp fun) (format "%S" fun)
(if (symbolp fun) (format-message "%S" fun)
(let* ((name (cdr (assq 'name (advice--props flist))))
(doc (documentation fun t))
(usage (help-split-fundoc doc function)))

View file

@ -1592,11 +1592,12 @@ SEEN is used internally to detect infinite recursion."
(unless problem
(setq problem
(if (stringp disabled)
(format "Package %s held at version %s, but version %s required"
next-pkg disabled
(package-version-join next-version))
(format "Required package %s is disabled"
next-pkg)))))
(format-message
"Package %s held at version %s, but version %s required"
next-pkg disabled
(package-version-join next-version))
(format-message "Required package %s is disabled"
next-pkg)))))
(t (setq found pkg-desc)))))
(unless found
(cond
@ -2365,16 +2366,16 @@ Otherwise no newline is inserted."
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
(when (y-or-n-p (format "Install package %s? "
(package-desc-full-name pkg-desc)))
(when (y-or-n-p (format-message "Install package %s? "
(package-desc-full-name pkg-desc)))
(package-install pkg-desc nil)
(revert-buffer nil t)
(goto-char (point-min)))))
(defun package-delete-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
(when (y-or-n-p (format "Delete package %s? "
(package-desc-full-name pkg-desc)))
(when (y-or-n-p (format-message "Delete package %s? "
(package-desc-full-name pkg-desc)))
(package-delete pkg-desc)
(revert-buffer nil t)
(goto-char (point-min)))))
@ -3077,8 +3078,8 @@ prompt (see `package-menu--prompt-transaction-p')."
(length packages)
(mapconcat #'package-desc-full-name packages ", ")))
;; Exactly 1
(t (format "package %s"
(package-desc-full-name (car packages))))))
(t (format-message "package %s"
(package-desc-full-name (car packages))))))
(defun package-menu--prompt-transaction-p (delete install upgrade)
"Prompt the user about DELETE, INSTALL, and UPGRADE.

View file

@ -324,7 +324,8 @@ This function is called, by name, directly by the C code."
(apply (timer--function timer) (timer--args timer)))
(error (message "Error running timer%s: %S"
(if (symbolp (timer--function timer))
(format " %s" (timer--function timer)) "")
(format-message " %s" (timer--function timer))
"")
err)))
(when (and retrigger
;; If the timer's been canceled, don't "retrigger" it

View file

@ -316,7 +316,7 @@ See also `warning-series', `warning-prefix-function' and
(defun lwarn (type level message &rest args)
"Display a warning message made from (format MESSAGE ARGS...).
\\<special-mode-map>
Aside from generating the message with `format',
Aside from generating the message with `format-message',
this is equivalent to `display-warning'.
TYPE is the warning type: either a custom group name (a symbol),
@ -332,15 +332,15 @@ LEVEL should be either :debug, :warning, :error, or :emergency
:error -- invalid data or circumstances.
:warning -- suspicious data or circumstances.
:debug -- info for debugging only."
(display-warning type (apply 'format message args) level))
(display-warning type (apply #'format-message message args) level))
;;;###autoload
(defun warn (message &rest args)
"Display a warning message made from (format MESSAGE ARGS...).
Aside from generating the message with `format',
Aside from generating the message with `format-message',
this is equivalent to `display-warning', using
`emacs' as the type and `:warning' as the level."
(display-warning 'emacs (apply 'format message args)))
(display-warning 'emacs (apply #'format-message message args)))
(provide 'warnings)

View file

@ -3447,8 +3447,8 @@ controlled by the sign of prefix numeric value."
(interactive)
(setq viper-parse-sexp-ignore-comments
(not viper-parse-sexp-ignore-comments))
(princ (format
"From now on, `%%' will %signore parentheses inside comment fields"
(princ (format-message
"From now on, %% will %signore parentheses inside comment fields"
(if viper-parse-sexp-ignore-comments "" "NOT "))))
@ -3986,8 +3986,8 @@ Null string will repeat previous search."
(if (null buffer) (error "`%s': No such buffer" buffer-name))
(if (or (not (buffer-modified-p buffer))
(y-or-n-p
(format
"Buffer `%s' is modified, are you sure you want to kill it? "
(format-message
"Buffer %s is modified, are you sure you want to kill it? "
buffer-name)))
(kill-buffer buffer)
(error "Buffer not killed"))))
@ -4636,8 +4636,8 @@ One can use \\=`\\=` and '' to temporarily jump 1 step back."
(substring text 0 (- pos s))
reg (substring text (- pos s)))))
(princ
(format
"Textmarker `%c' is in buffer `%s' at line %d.\n"
(format-message
"Textmarker %c is in buffer %s at line %d.\n"
reg (buffer-name buf) line-no))
(princ (format "Here is some text around %c:\n\n %s"
reg text)))

View file

@ -369,12 +369,12 @@ If SCOPE is nil, the user is asked to specify the scope."
(setq scope
(cond
((y-or-n-p
(format
"Map this macro for buffer `%s' only? "
(format-message
"Map this macro for buffer %s only? "
(buffer-name)))
(setq msg
(format
"%S is mapped to %s for %s in `%s'"
(format-message
"%S is mapped to %s for %s in %s"
(viper-display-macro macro-name)
(viper-abbreviate-string
(format
@ -385,12 +385,12 @@ If SCOPE is nil, the user is asked to specify the scope."
state-name (buffer-name)))
(buffer-name))
((y-or-n-p
(format
"Map this macro for the major mode `%S' only? "
(format-message
"Map this macro for the major mode %S only? "
major-mode))
(setq msg
(format
"%S is mapped to %s for %s in `%S'"
(format-message
"%S is mapped to %s for %s in %S"
(viper-display-macro macro-name)
(viper-abbreviate-string
(format

View file

@ -797,7 +797,7 @@ This is called whenever you create a new face, and at other times."
symbol (intern name)))
(setq menu 'facemenu-face-menu)
(setq docstring
(purecopy (format "Select face %s for subsequent insertion.
(purecopy (format-message "Select face %s for subsequent insertion.
If the mark is active and there is no prefix argument,
apply face %s to the region instead.
This command was defined by facemenu-add-new-face."

View file

@ -574,7 +574,7 @@ If FACE is a face-alias, get the documentation for the target face."
(let ((alias (get face 'face-alias)))
(if alias
(let ((doc (get alias 'face-documentation)))
(format "%s is an alias for the face %s.%s" face alias
(format-message "%s is an alias for the face %s.%s" face alias
(if doc (format "\n%s" doc)
"")))
(get face 'face-documentation))))
@ -1005,7 +1005,7 @@ a single face name."
(setq default (car (split-string default crm-separator t))))
(let ((prompt (if default
(format "%s (default %s): " prompt default)
(format-message "%s (default %s): " prompt default)
(format "%s: " prompt)))
aliasfaces nonaliasfaces faces)
;; Build up the completion tables.
@ -1136,10 +1136,10 @@ Value is the new attribute value."
(setq name (concat (upcase (substring name 0 1)) (substring name 1)))
(let* ((completion-ignore-case t)
(value (completing-read
(if default
(format "%s for face %s (default %s): "
name face default)
(format "%s for face %s: " name face))
(format-message (if default
"%s for face %s (default %s): "
"%s for face %s: ")
name face default)
completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
@ -1224,8 +1224,8 @@ of a global face. Value is the new attribute value."
"Read the name of a font for FACE on FRAME.
If optional argument FRAME is nil or omitted, use the selected frame."
(let ((completion-ignore-case t))
(completing-read (format "Set font attributes of face %s from font: "
face)
(completing-read (format-message
"Set font attributes of face %s from font: " face)
(append (fontset-list) (x-list-fonts "*" nil frame)))))
@ -1436,17 +1436,17 @@ If FRAME is omitted or nil, use the selected frame."
(when alias
(setq face alias)
(insert
(format (substitute-command-keys
"\n %s is an alias for the face %s.\n%s")
f alias
(if (setq obsolete (get f 'obsolete-face))
(format (substitute-command-keys
" This face is obsolete%s; use %s instead.\n")
(if (stringp obsolete)
(format " since %s" obsolete)
"")
alias)
""))))
(format-message
"\n %s is an alias for the face %s.\n%s"
f alias
(if (setq obsolete (get f 'obsolete-face))
(format-message
" This face is obsolete%s; use %s instead.\n"
(if (stringp obsolete)
(format " since %s" obsolete)
"")
alias)
""))))
(insert "\nDocumentation:\n"
(substitute-command-keys
(or (face-documentation face)

View file

@ -1641,8 +1641,8 @@ killed."
(user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
(not (yes-or-no-p
(format "Kill and replace buffer %s without saving it? "
(buffer-name))))
(format-message "Kill and replace buffer %s without saving it? "
(buffer-name))))
(user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
@ -3419,9 +3419,10 @@ local variables, but directory-local variables may still be applied."
(setq hack-local-variables--warned-lexical t)
(display-warning
:warning
(format "%s: lexical-binding at end of file unreliable"
(file-name-nondirectory
(or buffer-file-name ""))))))
(format-message
"%s: lexical-binding at end of file unreliable"
(file-name-nondirectory
(or buffer-file-name ""))))))
(t
(ignore-errors
(push (cons (if (eq var 'eval)
@ -3556,7 +3557,7 @@ It is dangerous if either of these conditions are met:
var (if since (format " (since %s)" since))
(if (stringp instead)
(substitute-command-keys instead)
(format "use %s instead" instead)))))))
(format-message "use %s instead" instead)))))))
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
@ -4028,7 +4029,8 @@ Interactively, confirmation is required unless you supply a prefix argument."
(not (and (eq (framep-on-display) 'ns)
(listp last-nonmenu-event)
use-dialog-box))
(or (y-or-n-p (format "File %s exists; overwrite? " filename))
(or (y-or-n-p (format-message
"File %s exists; overwrite? " filename))
(user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
@ -4733,8 +4735,9 @@ Before and after saving the buffer, this function runs
;; Signal an error if the user specified the name of an
;; existing directory.
(error "%s is a directory" filename)
(unless (y-or-n-p (format "File %s exists; overwrite? "
filename))
(unless (y-or-n-p (format-message
"File %s exists; overwrite? "
filename))
(error "Canceled"))))
(set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
@ -4774,7 +4777,8 @@ Before and after saving the buffer, this function runs
(expand-file-name buffer-file-name))))
(unless (file-exists-p dir)
(if (y-or-n-p
(format "Directory %s does not exist; create? " dir))
(format-message
"Directory %s does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1))))
@ -5217,8 +5221,8 @@ given. With a prefix argument, TRASH is nil."
(list dir
(if (directory-files dir nil directory-files-no-dot-files-regexp)
(y-or-n-p
(format "Directory %s is not empty, really %s? "
dir (if trashing "trash" "delete")))
(format-message "Directory %s is not empty, really %s? "
dir (if trashing "trash" "delete")))
nil)
(null current-prefix-arg))))
;; If default-directory is a remote directory, make sure we find its

View file

@ -395,8 +395,8 @@ unless you supply a prefix argument."
(cdr (assq 'default-directory
(buffer-local-variables)))
nil nil (buffer-name))))
(fmt (format-read (format "Write file %s in format: "
(file-name-nondirectory file)))))
(fmt (format-read (format-message "Write file %s in format: "
(file-name-nondirectory file)))))
(list file fmt (not current-prefix-arg))))
(let ((old-formats buffer-file-format)
preserve-formats)
@ -416,8 +416,8 @@ If FORMAT is nil then do not do any format conversion."
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
(fmt (format-read (format "Read file %s in format: "
(file-name-nondirectory file)))))
(fmt (format-read (format-message "Read file %s in format: "
(file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
(find-file filename))
@ -435,8 +435,8 @@ a list (ABSOLUTE-FILE-NAME SIZE)."
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
(fmt (format-read (format "Read file %s in format: "
(file-name-nondirectory file)))))
(fmt (format-read (format-message "Read file %s in format: "
(file-name-nondirectory file)))))
(list file fmt)))
(let (value size old-undo)
;; Record only one undo entry for the insertion. Inhibit point-motion and

View file

@ -319,9 +319,7 @@ suitable file is found, return nil."
(when remapped
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
(concat (substitute-command-keys "")
(symbol-name remapped)
(substitute-command-keys ""))
(format-message "%s" remapped)
"an anonymous command"))
(princ ".\n"))
@ -355,7 +353,7 @@ suitable file is found, return nil."
(insert "\nThis function has a compiler macro")
(if (symbolp handler)
(progn
(insert (format (substitute-command-keys " %s") handler))
(insert (format-message " %s" handler))
(save-excursion
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
@ -363,7 +361,7 @@ suitable file is found, return nil."
;; FIXME: Obsolete since 24.4.
(let ((lib (get function 'compiler-macro-file)))
(when (stringp lib)
(insert (format (substitute-command-keys " in %s") lib))
(insert (format-message " in %s" lib))
(save-excursion
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
@ -443,9 +441,7 @@ suitable file is found, return nil."
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
(use (format (substitute-command-keys
";\nuse %s instead.")
use))
(use (format-message ";\nuse %s instead." use))
(t "."))
"\n"))))
@ -481,9 +477,8 @@ FILE is the file where FUNCTION was probably defined."
(format ";\nin Lisp code %s" interactive-only))
((and (symbolp 'interactive-only)
(not (eq interactive-only t)))
(format (substitute-command-keys
";\nin Lisp code use %s instead.")
interactive-only))
(format-message ";\nin Lisp code use %s instead."
interactive-only))
(t "."))
"\n")))))
@ -551,8 +546,7 @@ FILE is the file where FUNCTION was probably defined."
;; Aliases are Lisp functions, so we need to check
;; aliases before functions.
(aliased
(format (substitute-command-keys "an alias for %s")
real-def))
(format-message "an alias for %s" real-def))
((autoloadp def)
(format "%s autoloaded %s"
(if (commandp def) "an interactive" "an")
@ -592,13 +586,12 @@ FILE is the file where FUNCTION was probably defined."
(help-xref-button 1 'help-function real-def)))))
(when file-name
(princ (substitute-command-keys " in "))
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
(princ (if (eq file-name 'C-source)
"C source code"
(help-fns-short-filename file-name)))
(princ (substitute-command-keys ""))
(princ (format-message " in %s"
(if (eq file-name 'C-source)
"C source code"
(help-fns-short-filename file-name))))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
@ -736,12 +729,11 @@ it is displayed along with the global value."
(if file-name
(progn
(princ (substitute-command-keys
" is a variable defined in "))
(princ (if (eq file-name 'C-source)
"C source code"
(file-name-nondirectory file-name)))
(princ (substitute-command-keys ".\n"))
(princ (format-message
" is a variable defined in %s.\n"
(if (eq file-name 'C-source)
"C source code"
(file-name-nondirectory file-name))))
(with-current-buffer standard-output
(save-excursion
(re-search-backward (substitute-command-keys
@ -876,9 +868,9 @@ if it is given a local binding.\n")))
;; Mention if it's an alias.
(unless (eq alias variable)
(setq extra-line t)
(princ (format (substitute-command-keys
" This variable is an alias for %s.\n")
alias)))
(princ (format-message
" This variable is an alias for %s.\n"
alias)))
(when obsolete
(setq extra-line t)
@ -886,9 +878,8 @@ if it is given a local binding.\n")))
(if (nth 2 obsolete)
(princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
(use (format (substitute-command-keys
";\n use %s instead.")
(car obsolete)))
(use (format-message ";\n use %s instead."
(car obsolete)))
(t ".")))
(terpri))
@ -950,8 +941,7 @@ file-local variable.\n")
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
"which is a byte-compiled expression.\n"
(format (substitute-command-keys "%s.\n")
safe-var))))
(format-message "%s.\n" safe-var))))
(if extra-line (terpri))
(princ "Documentation:\n")

View file

@ -964,9 +964,8 @@ documentation for the major and minor modes of that buffer."
(let* ((mode major-mode)
(file-name (find-lisp-object-file-name mode nil)))
(when file-name
(princ (concat (substitute-command-keys " defined in ")
(file-name-nondirectory file-name)
(substitute-command-keys "")))
(princ (format-message " defined in %s"
(file-name-nondirectory file-name)))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion

View file

@ -170,13 +170,13 @@ overall good/bad count summary inserted at the very end."
info-xref-good info-xref-bad info-xref-unavail))))
(defun info-xref-output (fmt &rest args)
"Emit a `format'-ed message FMT+ARGS to the `info-xref-output-buffer'."
"Emit a `format-message'-ed message FMT+ARGS to the `info-xref-output-buffer'."
(with-current-buffer info-xref-output-buffer
(save-excursion
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert info-xref-output-heading
(apply 'format fmt args)
(apply #'format-message fmt args)
"\n")))
(setq info-xref-output-heading "")
;; all this info-xref can be pretty slow, display now so the user sees

View file

@ -3460,7 +3460,7 @@ MATCHES is a list of index matches found by `Info-index'.")
(when (equal (car (nth 0 nodeinfo)) (or filename Info-current-file))
(insert
(format "* %-20s %s.\n"
(format "*Index for %s*::" (cdr (nth 0 nodeinfo)))
(format-message "*Index for %s*::" (cdr (nth 0 nodeinfo)))
(cdr (nth 0 nodeinfo)))))))))
(defun Info-virtual-index (topic)
@ -3495,7 +3495,8 @@ search results."
(setq Info-history-list ohist-list)
(Info-goto-node orignode)
(message "")))
(Info-find-node Info-current-file (format "*Index for %s*" topic))))
(Info-find-node Info-current-file
(format-message "*Index for %s*" topic))))
(add-to-list 'Info-virtual-files
'("\\`\\*Apropos\\*\\'"
@ -3634,7 +3635,7 @@ Build a menu of the possible matches."
(setq nodes (cdr nodes)))
(if nodes
(Info-find-node Info-apropos-file (car (car nodes)))
(setq nodename (format "Index for %s" string))
(setq nodename (format-message "Index for %s" string))
(push (list nodename string (Info-apropos-matches string))
Info-apropos-nodes)
(Info-find-node Info-apropos-file nodename)))))

View file

@ -209,7 +209,7 @@ area while indicating the current selection by `<N>'."
(define-error 'kkc-error nil)
(defun kkc-error (&rest args)
(signal 'kkc-error (apply 'format args)))
(signal 'kkc-error (apply #'format-message args)))
(defvar kkc-converting nil)

View file

@ -719,14 +719,14 @@ DEFAULT is the coding system to use by default in the query."
(insert "No default coding systems to try for "
(if (stringp from)
(format "string \"%s\"." from)
(format "buffer %s." bufname)))
(format-message "buffer %s." bufname)))
(insert
"These default coding systems were tried to encode"
(if (stringp from)
(concat " \"" (if (> (length from) 10)
(concat (substring from 0 10) "...\"")
(concat from "\"")))
(format " text\nin the buffer %s" bufname))
(format-message " text\nin the buffer %s" bufname))
":\n")
(let ((pos (point))
(fill-prefix " "))
@ -881,7 +881,7 @@ for the current buffer/file by the %s.
It is highly recommended to fix it before writing to a file."
(car auto-cs)
(if (eq (cdr auto-cs) :coding) ":coding tag"
(format "variable %s" (cdr auto-cs))))
(format-message "variable %s" (cdr auto-cs))))
:warning)
(or (yes-or-no-p "Really proceed with writing? ")
(error "Save aborted"))
@ -1587,7 +1587,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(let ((elt (assoc input-method input-method-alist)))
(princ (format
(princ (format-message
"Input method: %s (%s in mode line) for %s\n %s\n"
input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))

View file

@ -904,8 +904,9 @@
(dolist (script '(devanagari sanskrit bengali tamil telugu assamese
oriya kannada malayalam gujarati punjabi))
(define-charset (intern (format "%s-cdac" script))
(format "Glyphs of %s script for CDAC font. Subset of indian-glyph."
(capitalize (symbol-name script)))
(format-message
"Glyphs of %s script for CDAC font. Subset of indian-glyph."
(capitalize (symbol-name script)))
:short-name (format "CDAC %s glyphs" (capitalize (symbol-name script)))
:supplementary-p t
:code-space [0 255]
@ -915,8 +916,9 @@
(dolist (script '(devanagari bengali punjabi gujarati
oriya tamil telugu kannada malayalam))
(define-charset (intern (format "%s-akruti" script))
(format "Glyphs of %s script for AKRUTI font. Subset of indian-glyph."
(capitalize (symbol-name script)))
(format-message
"Glyphs of %s script for AKRUTI font. Subset of indian-glyph."
(capitalize (symbol-name script)))
:short-name (format "AKRUTI %s glyphs" (capitalize (symbol-name script)))
:supplementary-p t
:code-space [0 255]

View file

@ -332,7 +332,7 @@ meanings of these arguments."
(let ((char (charset-iso-final-char charset)))
(when (> char 0)
(insert "Final char of ISO2022 designation sequence: ")
(insert (format "%c\n" char))))
(insert (format-message "%c\n" char))))
(let (aliases)
(dolist (c charset-list)
(if (and (not (eq c charset))
@ -1058,17 +1058,18 @@ installed LEIM (Libraries of Emacs Input Methods).")
(setq language (nth 1 elt))
(princ language)
(terpri))
(princ (format " %s (%s in mode line)\n %s\n"
(car elt)
(let ((title (nth 3 elt)))
(if (and (consp title) (stringp (car title)))
(car title)
title))
;; If the doc is multi-line, indent all
;; non-blank lines. (Bug#8066)
(replace-regexp-in-string
"\n\\(.\\)" "\n \\1"
(substitute-command-keys (or (nth 4 elt) "")))))))))
(princ (format-message
" %s (%s in mode line)\n %s\n"
(car elt)
(let ((title (nth 3 elt)))
(if (and (consp title) (stringp (car title)))
(car title)
title))
;; If the doc is multi-line, indent all
;; non-blank lines. (Bug#8066)
(replace-regexp-in-string
"\n\\(.\\)" "\n \\1"
(substitute-command-keys (or (nth 4 elt) "")))))))))
;;; DIAGNOSIS

View file

@ -1305,7 +1305,7 @@ The returned value is a Quail map specific to KEY."
(define-error 'quail-error nil)
(defun quail-error (&rest args)
(signal 'quail-error (apply 'format args)))
(signal 'quail-error (apply #'format-message args)))
(defun quail-input-string-to-events (str)
"Convert input string STR to a list of events.

View file

@ -687,7 +687,7 @@ for use at QPOS."
The text is displayed for `minibuffer-message-timeout' seconds,
or until the next input event arrives, whichever comes first.
Enclose MESSAGE in [...] if this is not yet the case.
If ARGS are provided, then pass MESSAGE through `format'."
If ARGS are provided, then pass MESSAGE through `format-message'."
(if (not (minibufferp (current-buffer)))
(progn
(if args
@ -702,7 +702,7 @@ If ARGS are provided, then pass MESSAGE through `format'."
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
(when args (setq message (apply 'format message args)))
(when args (setq message (apply #'format-message message args)))
(let ((ol (make-overlay (point-max) (point-max) nil t t))
;; A quit during sit-for normally only interrupts the sit-for,
;; but since minibuffer-message is used at the end of a command,

View file

@ -217,7 +217,7 @@ defaults to 6600 and HOST defaults to localhost."
(goto-char (point-max))
(insert-before-markers ;So it scrolls.
(replace-regexp-in-string "\n" "\n "
(apply 'format format args))
(apply #'format-message format args))
"\n"))))
(defun mpc--proc-filter (proc string)
@ -1643,7 +1643,7 @@ Return non-nil if a selection was deactivated."
(when (equal (sort (copy-sequence active) #'string-lessp)
(sort (copy-sequence selection) #'string-lessp))
(setq active 'all)))
;; FIXME: This `mpc-sort' takes a lot of time. Maybe we should
;; be more clever and presume the buffer is mostly sorted already.
(mpc-sort (if (listp active) active))

View file

@ -745,8 +745,8 @@ to the buffer-list variable in FUNCTION-INFO."
(msb--add-to-menu buffer info max-buffer-name-length)))
(error (unless msb--error
(setq msb--error
(format
"In msb-menu-cond, error for buffer `%s'."
(format-message
"In msb-menu-cond, error for buffer %s."
(buffer-name buffer)))
(error "%s" msb--error))))))

View file

@ -1107,7 +1107,7 @@ All HOST values should be in lower case.")
(defun ange-ftp-message (fmt &rest args)
"Display message in echo area, but indicate if truncated.
Args are as in `message': a format string, plus arguments to be formatted."
(let ((msg (apply 'format fmt args))
(let ((msg (apply #'format-message fmt args))
(max (window-width (minibuffer-window))))
(if noninteractive
msg

View file

@ -259,7 +259,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(message "%s: (err=[%s] %s) %s"
"gnutls.el"
doit (gnutls-error-string doit)
(apply 'format format (or params '(nil))))))
(apply #'format-message format (or params '(nil))))))
(provide 'gnutls)

View file

@ -846,10 +846,10 @@ Argument BUFFER is the buffer of the retrieval process."
newsticker--cache
name-symbol
newsticker--error-headline
(format
(format-message
(concat "%s: Newsticker could not retrieve news from %s.\n"
"Return status: `%s'\n"
"Command was `%s'")
"Return status: %s\n"
"Command was %s")
(format-time-string "%A, %H:%M")
feed-name event command)
""

View file

@ -1268,8 +1268,8 @@ Note: does not update the layout."
(expand-file-name (concat newsticker-dir "/groups"))))
(file-exists-p newsticker-groups-filename)
(y-or-n-p
(format
(concat "Obsolete variable `newsticker-groups-filename' "
(format-message
(concat "Obsolete variable newsticker-groups-filename "
"points to existing file \"%s\".\n"
"Read it? ")
newsticker-groups-filename))
@ -1279,9 +1279,9 @@ Note: does not update the layout."
(find-file-noselect filename))))
(and newsticker-groups-filename
(file-exists-p newsticker-groups-filename)
(y-or-n-p (format
(y-or-n-p (format-message
(concat "Delete the file \"%s\",\nto which the obsolete "
"variable `newsticker-groups-filename' points ? ")
"variable newsticker-groups-filename points ? ")
newsticker-groups-filename))
(delete-file newsticker-groups-filename))
(when buf

View file

@ -304,7 +304,7 @@ unencrypted."
(when (> (length cert) 0)
(insert cert "\n"))
(let ((start (point)))
(insert (apply 'format message args))
(insert (apply #'format-message message args))
(goto-char start)
;; Fill the first line of the message, which usually
;; contains lots of explanatory text.

View file

@ -174,8 +174,8 @@ If you wish to change directory tracking styles during a session, use the
function `rlogin-directory-tracking-mode' rather than simply setting the
variable."
(interactive (list
(read-from-minibuffer (format
"Arguments for `%s' (hostname first): "
(read-from-minibuffer (format-message
"Arguments for %s (hostname first): "
(file-name-nondirectory rlogin-program))
nil nil nil 'rlogin-history)
current-prefix-arg))

View file

@ -51,7 +51,8 @@
(defsubst soap-warning (message &rest args)
"Display a warning MESSAGE with ARGS, using the 'soap-client warning type."
(display-warning 'soap-client (apply 'format message args) :warning))
(display-warning 'soap-client (apply #'format-message message args)
:warning))
(defgroup soap-client nil
"Access SOAP web services from Emacs."

View file

@ -1504,7 +1504,7 @@ ARGUMENTS to actually emit the message (if applicable)."
; (1+ (count-lines (point-min) (cdr ffn)))))))
(insert (format "%s " fn)))
;; The message.
(insert (apply 'format fmt-string arguments))))
(insert (apply #'format-message fmt-string arguments))))
(defvar tramp-message-show-message t
"Show Tramp message in the minibuffer.
@ -1581,8 +1581,8 @@ signal identifier to be raised, remaining arguments passed to
(error-message-string
(list signal
(get signal 'error-message)
(apply 'format fmt-string arguments)))))
(signal signal (list (apply 'format fmt-string arguments)))))
(apply #'format-message fmt-string arguments)))))
(signal signal (list (apply #'format-message fmt-string arguments)))))
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
@ -3599,8 +3599,8 @@ connection buffer."
"Tramp failed to connect. If this happens repeatedly, try\n"
" `\\[tramp-cleanup-this-connection]'")))
((eq exit 'timeout)
(format
"Timeout reached, see buffer `%s' for details"
(format-message
"Timeout reached, see buffer %s for details"
(tramp-get-connection-buffer vec)))
(t "Login failed")))))
(when (numberp pos)

View file

@ -1003,7 +1003,7 @@ immediately after the section's start-tag."
;;; Error handling
(defun nxml-report-outline-error (msg err)
(error msg (apply 'format (cdr err))))
(error msg (apply #'format-message (cdr err))))
(defun nxml-outline-error (&rest args)
(signal 'nxml-outline-error args))

View file

@ -304,7 +304,7 @@ same way as well-formedness error."
(defun nxml-parse-error (position &rest args)
(nxml-signal-file-parse-error nxml-parse-file-name
(or position xmltok-start)
(apply 'format args)))
(apply #'format-message args)))
(defun nxml-check-xmltok-errors ()
(when xmltok-errors

View file

@ -400,7 +400,7 @@ OVERRIDE is either nil, require or t."
(defun rng-c-error (&rest args)
(rng-c-signal-incorrect-schema rng-c-file-name
(rng-c-translate-position (point))
(apply 'format args)))
(apply #'format-message args)))
(defun rng-c-parse-top-level (context)
(let ((rng-c-namespace-decls nil)

View file

@ -1504,7 +1504,7 @@ nullable and y1 isn't, return a choice
(defun rng-compile-error (&rest args)
(signal 'rng-compile-error
(list (apply 'format args))))
(list (apply #'format-message args))))
(define-error 'rng-compile-error "Incorrect schema" 'rng-error)

View file

@ -125,7 +125,7 @@ Signal an error if URI is not a valid file URL."
(t path))))
(defun rng-uri-error (&rest args)
(signal 'rng-uri-error (list (apply 'format args))))
(signal 'rng-uri-error (list (apply #'format-message args))))
(define-error 'rng-uri-error "Invalid URI")

View file

@ -1095,8 +1095,8 @@ Return the modified list with the last element prepended to it."
(and iswitchb-prompt-newbuffer
(y-or-n-p
(format
"No buffer matching `%s', create one? "
(format-message
"No buffer matching %s, create one? "
buf)))))
;; then create a new buffer
(progn

View file

@ -455,8 +455,8 @@ to rebuild (update) the TAGS file."
Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
(if (and (buffer-file-name)
(y-or-n-p
(format
"Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
(format-message
"Tag %s not found. Rebuild table %s/TAGS and look again?"
name
(file-name-directory (buffer-file-name)))))
(org-ctags-rebuild-tags-file-then-find-tag name)

View file

@ -1915,7 +1915,7 @@ and \f (formfeed) at the end."
(let (buffer-read-only)
(cond ((stringp log)
(insert (if args
(apply 'format log args)
(apply #'format-message log args)
log)))
((bufferp log)
(insert-buffer-substring log))

View file

@ -6345,7 +6345,7 @@ killed after process termination."
(when ebnf-log
(with-current-buffer (get-buffer-create "*Ebnf2ps Log*")
(goto-char (point-max))
(insert (apply 'format format-str args) "\n"))))
(insert (apply #'format-message format-str args) "\n"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -200,7 +200,7 @@ ignored. Otherwise, it is printed using `message'.
TEXT is a format control string, and the remaining arguments ARGS
are the string substitutions (see the function `format')."
(if (<= level flymake-log-level)
(let* ((msg (apply 'format text args)))
(let* ((msg (apply #'format-message text args)))
(message "%s" msg))))
(defun flymake-ins-after (list pos val)

View file

@ -2305,11 +2305,12 @@ Ignore byte-compiler warnings you might see."
(defun vhdl-warning-when-idle (&rest args)
"Wait until idle, then print out warning STRING and beep."
(if noninteractive
(vhdl-warning (apply 'format args) t)
(unless vhdl-warnings
(vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
(push (apply 'format args) vhdl-warnings)))
(let ((message (apply #'format-message args)))
(if noninteractive
(vhdl-warning message t)
(unless vhdl-warnings
(vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
(push message vhdl-warnings))))
(defun vhdl-warning (string &optional nobeep)
"Print out warning STRING and beep."

View file

@ -1495,7 +1495,8 @@ See also `multi-occur'."
;; Don't display regexp if with remaining text
;; it is longer than window-width.
(if (> (+ (length regexp) 42) (window-width))
"" (format " for %s" (query-replace-descr regexp)))))
"" (format-message
" for %s" (query-replace-descr regexp)))))
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)

View file

@ -1689,11 +1689,11 @@ invoking, give a prefix argument to `execute-extended-command'."
(symbol-name function) typed))))
(when binding
(with-temp-message
(format "You can run the command %s with %s"
function
(if (stringp binding)
(concat "M-x " binding " RET")
(key-description binding)))
(format-message "You can run the command %s with %s"
function
(if (stringp binding)
(concat "M-x " binding " RET")
(key-description binding)))
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
@ -2796,16 +2796,18 @@ This variable only matters if `undo-ask-before-discard' is non-nil.")
;; but we don't want to ask the question again.
(setq undo-extra-outer-limit (+ size 50000))
(if (let (use-dialog-box track-mouse executing-kbd-macro )
(yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
(buffer-name) size)))
(yes-or-no-p (format-message
"Buffer %s undo info is %d bytes long; discard it? "
(buffer-name) size)))
(progn (setq buffer-undo-list nil)
(setq undo-extra-outer-limit nil)
t)
nil))
(display-warning '(undo discard-info)
(concat
(format "Buffer %s undo info was %d bytes long.\n"
(buffer-name) size)
(format-message
"Buffer %s undo info was %d bytes long.\n"
(buffer-name) size)
"The undo info was discarded because it exceeded \
`undo-outer-limit'.
@ -8326,8 +8328,9 @@ contains the list of implementations currently supported for this command."
(interactive "P")
(when (or arg (null ,varimp-sym))
(let ((val (completing-read
,(format "Select implementation for command %s: "
command-name)
,(format-message
"Select implementation for command %s: "
command-name)
,varalt-sym nil t)))
(unless (string-equal val "")
(when (null ,varimp-sym)
@ -8339,8 +8342,9 @@ contains the list of implementations currently supported for this command."
(cdr (assoc-string val ,varalt-sym))))))
(if ,varimp-sym
(call-interactively ,varimp-sym)
(message ,(format "No implementation selected for command %s"
command-name)))))))
(message "%s" ,(format-message
"No implementation selected for command %s"
command-name)))))))

View file

@ -1177,7 +1177,8 @@ please check its value")
(error
(display-warning
'initialization
(format "An error occurred while loading %s:\n\n%s%s%s\n\n\
(format-message "\
An error occurred while loading %s:\n\n%s%s%s\n\n\
To ensure normal operation, you should investigate and remove the
cause of the error in your initialization file. Start Emacs with
the --debug-init option to view a complete error backtrace."
@ -1312,7 +1313,8 @@ the --debug-init option to view a complete error backtrace."
(expand-file-name user-emacs-directory))
(setq warned t)
(display-warning 'initialization
(format "Your load-path seems to contain
(format-message "\
Your load-path seems to contain\n\
your .emacs.d directory: %s\n\
This is likely to cause problems...\n\
Consider using a subdirectory instead, e.g.: %s"

View file

@ -288,6 +288,12 @@ This function accepts any number of arguments, but ignores them."
(interactive)
nil)
(defun format-message (format-string &rest args)
"Format a string out of FORMAT-STRING and arguments.
This is like format, except it also converts curved quotes in
FORMAT-STRING as per text-quoting-style."
(apply #'format (internal--text-restyle format-string) args))
;; Signal a compile-error if the first arg is missing.
(defun error (&rest args)
"Signal an error, making error message by passing all args to `format'.
@ -295,7 +301,7 @@ In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
(declare (advertised-calling-convention (string &rest args) "23.1"))
(signal 'error (list (apply 'format args))))
(signal 'error (list (apply #'format-message args))))
(defun user-error (format &rest args)
"Signal a pilot error, making error message by passing all args to `format'.
@ -305,7 +311,7 @@ for the sake of consistency.
This is just like `error' except that `user-error's are expected to be the
result of an incorrect manipulation on the part of the user, rather than the
result of an actual problem."
(signal 'user-error (list (apply #'format format args))))
(signal 'user-error (list (apply #'format-message format args))))
(defun define-error (name message &optional parent)
"Define NAME as a new error signal.
@ -1606,8 +1612,9 @@ can do the job."
exp
(let* ((sym (cadr list-var))
(append (eval append))
(msg (format "add-to-list can't use lexical var %s; use push or cl-pushnew"
sym))
(msg (format-message
"add-to-list can't use lexical var %s; use push or cl-pushnew"
sym))
;; Big ugly hack so we only output a warning during
;; byte-compilation, and so we can use
;; byte-compile-not-lexical-var-p to silence the warning

View file

@ -141,12 +141,13 @@ options:
db))
(insert "However, your customizations have "
(if cb
(format "rebound it to the command %s" cb)
(format-message "rebound it to the command %s" cb)
"unbound it"))
(insert ".")
(when mapsym
(insert " (For the more advanced user:"
(format " This binding is in the keymap %s.)" mapsym)))
(format-message
" This binding is in the keymap %s.)" mapsym)))
(if (string= where "")
(unless (keymapp db)
(insert "\n\nYou can use M-x "
@ -158,7 +159,7 @@ options:
""
"the key")
where
(format " to get the function %s." db))))
(format-message " to get the function %s." db))))
(fill-region (point-min) (point)))))
(help-print-return-message))))
@ -450,7 +451,7 @@ where
(lookup-key global-map
[menu-bar]))))
(stringp cwhere))
(format "the %s menu" cwhere)
(format-message "the %s menu" cwhere)
"the menus"))))
(setq where ""))
(setq remark nil)

View file

@ -511,6 +511,7 @@ invoke it. If KEYS is omitted or nil, the return value of
for (i = 2; *tem; i++)
{
visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
visargs[1] = Finternal__text_restyle (visargs[1]);
if (strchr (SSDATA (visargs[1]), '%'))
callint_message = Fformat (i - 1, visargs + 1);
else

View file

@ -1028,6 +1028,67 @@ Otherwise, return a new string. */)
xfree (buf);
RETURN_UNGCPRO (tem);
}
DEFUN ("internal--text-restyle", Finternal__text_restyle,
Sinternal__text_restyle, 1, 1, 0,
doc: /* Return STRING, possibly substituting quote characters.
In the result, replace each curved single quote (\\= and \\=) by
left and right quote characters as specified by text-quoting-style.
Return the original STRING in the common case where no changes are needed.
Otherwise, return a new string. */)
(Lisp_Object string)
{
bool changed = false;
CHECK_STRING (string);
if (! STRING_MULTIBYTE (string))
return string;
enum text_quoting_style quoting_style = text_quoting_style ();
if (quoting_style == CURVE_QUOTING_STYLE)
return string;
ptrdiff_t bsize = SBYTES (string);
unsigned char const *strp = SDATA (string);
unsigned char const *strlim = strp + bsize;
USE_SAFE_ALLOCA;
char *buf = SAFE_ALLOCA (bsize);
char *bufp = buf;
ptrdiff_t nchars = 0;
while (strp < strlim)
{
unsigned char const *cp = strp;
switch (STRING_CHAR_ADVANCE (strp))
{
case LEFT_SINGLE_QUOTATION_MARK:
*bufp++ = quoting_style == GRAVE_QUOTING_STYLE ? '`': '\'';
changed = true;
break;
case RIGHT_SINGLE_QUOTATION_MARK:
*bufp++ = '\'';
changed = true;
break;
default:
do
*bufp++ = *cp++;
while (cp != strp);
break;
}
nchars++;
}
Lisp_Object result
= changed ? make_string_from_bytes (buf, nchars, bufp - buf) : string;
SAFE_FREE ();
return result;
}
void
syms_of_doc (void)
@ -1061,4 +1122,5 @@ displayable, and like grave otherwise. */);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Ssubstitute_command_keys);
defsubr (&Sinternal__text_restyle);
}

View file

@ -3696,8 +3696,8 @@ usage: (message FORMAT-STRING &rest ARGS) */)
}
else
{
register Lisp_Object val;
val = Fformat (nargs, args);
args[0] = Finternal__text_restyle (args[0]);
Lisp_Object val = Fformat (nargs, args);
message3 (val);
return val;
}
@ -3722,6 +3722,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
}
else
{
args[0] = Finternal__text_restyle (args[0]);
Lisp_Object val = Fformat (nargs, args);
Lisp_Object pane, menu;
struct gcpro gcpro1;