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:
@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}:
@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}
@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}).
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
* 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.
@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
@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
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
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
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.
‘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
(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.
(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 ")
(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))
(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))
(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]+\\) *\\(.*\\)\\'"
(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
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
- (format
+ (format-message
"\n‘v’ 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)
(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))
(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))
(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"
(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))))
(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
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? "))))
(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
)
((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))))
(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)))))
"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
(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 ()
(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.
(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)
;; 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)
(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))
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.
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)))
;; (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))
(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))
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))
(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.
(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)))
(`(',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))
(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
(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
(`((,(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
(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 ,_)
;; ((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
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" ())
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)
(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)))
(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)
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))))))
(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)
((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))
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)))
;; 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.
(elint-set-mode-line t)
(with-current-buffer elint-log-buffer
(unless (string-equal default-directory dir)
- (elint-log-message (format "\f\nLeaving directory ‘%s’"
- default-directory) t)
- (elint-log-message (format "Entering directory ‘%s’" dir) t)
+ (elint-log-message (format-message "\f\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)
(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.
(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
(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."
(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);
(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)))
(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
(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)))))
(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.
(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
(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),
: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)
(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 "))))
\f
(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"))))
(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)))
(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
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
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’."
(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))))
(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.
(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)))
"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)))))
(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)
(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)
(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)
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.
(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)
;; 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))
(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))))
(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
(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)
(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))
(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
(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"))
(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)
;; 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)
(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"))))
(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")))))
;; 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")
(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
(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
;; 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)
(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))
(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")
(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
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
(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)
(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))))
\f
(add-to-list 'Info-virtual-files
'("\\`\\*Apropos\\*\\'"
(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)))))
(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)
(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 " "))
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"))
(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))))))))))
(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]
(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]
(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))
(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) "")))))))))
\f
;;; DIAGNOSIS
(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.
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
;; 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,
(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)
(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))
(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))))))
(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
(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)
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)
""
(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))
(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
(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.
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))
(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."
; (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.
(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)
"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)
;;; 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))
(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
(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)
(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)
(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")
(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
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)
(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))
(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"))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
(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."
;; 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)
(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))))))))
;; 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'.
(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)
(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)))))))
\f
(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."
(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"
(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'.
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'.
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.
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
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 "
""
"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))))
(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)
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
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;
+}
\f
void
syms_of_doc (void)
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Ssubstitute_command_keys);
+ defsubr (&Sinternal__text_restyle);
}
}
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;
}
}
else
{
+ args[0] = Finternal__text_restyle (args[0]);
Lisp_Object val = Fformat (nargs, args);
Lisp_Object pane, menu;
struct gcpro gcpro1;