diff options
| author | Basil L. Contovounesios | 2020-05-29 19:56:14 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2020-06-18 12:46:21 +0100 |
| commit | 0185d76e7426eb1b58a9b60b0d18e763ddf57dea (patch) | |
| tree | 68e6f560b1751902e98a241a3bf732b9fd596364 | |
| parent | 97d1f672ac1529ac07a999405f630cb19a1010eb (diff) | |
| download | emacs-0185d76e7426eb1b58a9b60b0d18e763ddf57dea.tar.gz emacs-0185d76e7426eb1b58a9b60b0d18e763ddf57dea.zip | |
Fix and extend format-spec (bug#41758)
* lisp/format-spec.el: Use lexical-binding. Remove dependence on
subr-x.el.
(format-spec-make): Clarify docstring.
(format-spec--parse-modifiers): Rename to...
(format-spec--parse-flags): ...this and simplify. In particular,
don't bother parsing :space-pad which is redundant and unused.
(format-spec--pad): Remove, replacing with...
(format-spec--do-flags): ...this new helper function which performs
more of format-spec's supported text manipulation.
(format-spec): Autoload. Allow optional argument to take on special
values 'ignore' and 'delete' for more control over what happens when
a replacement for a format specification isn't provided. Bring back
proper support for a precision modifier similar to that of 'format'.
* lisp/battery.el (battery-format): Rewrite in terms of format-spec.
(battery-echo-area-format, battery-mode-line-format): Mention
support of format-spec syntax in docstrings.
* doc/lispref/strings.texi (Custom Format Strings):
* etc/NEWS: Document and announce these changes.
* lisp/dired-aux.el (dired-do-compress-to):
* lisp/erc/erc-match.el (erc-log-matches):
* lisp/erc/erc.el (erc-update-mode-line-buffer):
* lisp/gnus/gnus-sieve.el (gnus-sieve-update):
* lisp/gnus/gssapi.el (open-gssapi-stream):
* lisp/gnus/mail-source.el (mail-source-fetch-file)
(mail-source-fetch-directory, mail-source-fetch-pop)
(mail-source-fetch-imap):
* lisp/gnus/message.el (message-insert-formatted-citation-line):
* lisp/image-dired.el:
* lisp/net/eww.el:
* lisp/net/imap.el (imap-kerberos4-open, imap-gssapi-open)
(imap-shell-open):
* lisp/net/network-stream.el (network-stream-open-shell):
* lisp/obsolete/tls.el (open-tls-stream):
* lisp/textmodes/tex-mode.el:
Remove extraneous loads and autoloads of format-spec now that it is
autoloaded and simplify its uses where possible.
* test/lisp/battery-tests.el (battery-format): Test new format-spec
support.
* test/lisp/format-spec-tests.el (test-format-spec): Rename to...
(format-spec) ...this, extending test cases.
(test-format-unknown): Rename to...
(format-spec-unknown): ...this, extending test cases.
(test-format-modifiers): Rename to...
(format-spec-flags): ...this.
(format-spec-make, format-spec-parse-flags, format-spec-do-flags)
(format-spec-do-flags-truncate, format-spec-do-flags-pad)
(format-spec-do-flags-chop, format-spec-do-flags-case): New tests.
| -rw-r--r-- | doc/lispref/strings.texi | 35 | ||||
| -rw-r--r-- | etc/NEWS | 17 | ||||
| -rw-r--r-- | lisp/battery.el | 18 | ||||
| -rw-r--r-- | lisp/dired-aux.el | 15 | ||||
| -rw-r--r-- | lisp/erc/erc-match.el | 19 | ||||
| -rw-r--r-- | lisp/erc/erc.el | 21 | ||||
| -rw-r--r-- | lisp/format-spec.el | 183 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sieve.el | 10 | ||||
| -rw-r--r-- | lisp/gnus/gssapi.el | 11 | ||||
| -rw-r--r-- | lisp/gnus/mail-source.el | 30 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 137 | ||||
| -rw-r--r-- | lisp/image-dired.el | 1 | ||||
| -rw-r--r-- | lisp/net/eww.el | 1 | ||||
| -rw-r--r-- | lisp/net/imap.el | 30 | ||||
| -rw-r--r-- | lisp/net/network-stream.el | 13 | ||||
| -rw-r--r-- | lisp/obsolete/tls.el | 16 | ||||
| -rw-r--r-- | lisp/textmodes/tex-mode.el | 3 | ||||
| -rw-r--r-- | test/lisp/battery-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/format-spec-tests.el | 135 |
19 files changed, 408 insertions, 291 deletions
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 4a7bda57c4e..2ef88b90254 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi | |||
| @@ -1152,7 +1152,7 @@ The function @code{format-spec} described in this section performs a | |||
| 1152 | similar function to @code{format}, except it operates on format | 1152 | similar function to @code{format}, except it operates on format |
| 1153 | control strings that use arbitrary specification characters. | 1153 | control strings that use arbitrary specification characters. |
| 1154 | 1154 | ||
| 1155 | @defun format-spec template spec-alist &optional only-present | 1155 | @defun format-spec template spec-alist &optional ignore-missing |
| 1156 | This function returns a string produced from the format string | 1156 | This function returns a string produced from the format string |
| 1157 | @var{template} according to conversions specified in @var{spec-alist}, | 1157 | @var{template} according to conversions specified in @var{spec-alist}, |
| 1158 | which is an alist (@pxref{Association Lists}) of the form | 1158 | which is an alist (@pxref{Association Lists}) of the form |
| @@ -1185,12 +1185,15 @@ The order of specifications in @var{template} need not correspond to | |||
| 1185 | the order of associations in @var{spec-alist}. | 1185 | the order of associations in @var{spec-alist}. |
| 1186 | @end itemize | 1186 | @end itemize |
| 1187 | 1187 | ||
| 1188 | The optional argument @var{only-present} indicates how to handle | 1188 | The optional argument @var{ignore-missing} indicates how to handle |
| 1189 | specification characters in @var{template} that are not found in | 1189 | specification characters in @var{template} that are not found in |
| 1190 | @var{spec-alist}. If it is @code{nil} or omitted, the function | 1190 | @var{spec-alist}. If it is @code{nil} or omitted, the function |
| 1191 | signals an error. Otherwise, those format specifications and any | 1191 | signals an error; if it is @code{ignore}, those format specifications |
| 1192 | occurrences of @samp{%%} in @var{template} are left verbatim in the | 1192 | are left verbatim in the output, including their text properties, if |
| 1193 | output, including their text properties, if any. | 1193 | any; if it is @code{delete}, those format specifications are removed |
| 1194 | from the output; any other non-@code{nil} value is handled like | ||
| 1195 | @code{ignore}, but any occurrences of @samp{%%} are also left verbatim | ||
| 1196 | in the output. | ||
| 1194 | @end defun | 1197 | @end defun |
| 1195 | 1198 | ||
| 1196 | The syntax of format specifications accepted by @code{format-spec} is | 1199 | The syntax of format specifications accepted by @code{format-spec} is |
| @@ -1238,7 +1241,7 @@ the right rather than the left. | |||
| 1238 | 1241 | ||
| 1239 | @item < | 1242 | @item < |
| 1240 | This flag causes the substitution to be truncated on the left to the | 1243 | This flag causes the substitution to be truncated on the left to the |
| 1241 | given width, if specified. | 1244 | given width and precision, if specified. |
| 1242 | 1245 | ||
| 1243 | @item > | 1246 | @item > |
| 1244 | This flag causes the substitution to be truncated on the right to the | 1247 | This flag causes the substitution to be truncated on the right to the |
| @@ -1257,9 +1260,12 @@ The result of using contradictory flags (for instance, both upper and | |||
| 1257 | lower case) is undefined. | 1260 | lower case) is undefined. |
| 1258 | 1261 | ||
| 1259 | As is the case with @code{format}, a format specification can include | 1262 | As is the case with @code{format}, a format specification can include |
| 1260 | a width, which is a decimal number that appears after any flags. If a | 1263 | a width, which is a decimal number that appears after any flags, and a |
| 1261 | substitution contains fewer characters than its specified width, it is | 1264 | precision, which is a decimal-point @samp{.} followed by a decimal |
| 1262 | padded on the left: | 1265 | number that appears after any flags and width. |
| 1266 | |||
| 1267 | If a substitution contains fewer characters than its specified width, | ||
| 1268 | it is padded on the left: | ||
| 1263 | 1269 | ||
| 1264 | @example | 1270 | @example |
| 1265 | @group | 1271 | @group |
| @@ -1269,6 +1275,17 @@ padded on the left: | |||
| 1269 | @end group | 1275 | @end group |
| 1270 | @end example | 1276 | @end example |
| 1271 | 1277 | ||
| 1278 | If a substitution contains more characters than its specified | ||
| 1279 | precision, it is truncated on the right: | ||
| 1280 | |||
| 1281 | @example | ||
| 1282 | @group | ||
| 1283 | (format-spec "%.2a is truncated on the right" | ||
| 1284 | '((?a . "alpha"))) | ||
| 1285 | @result{} "al is truncated on the right" | ||
| 1286 | @end group | ||
| 1287 | @end example | ||
| 1288 | |||
| 1272 | Here is a more complicated example that combines several | 1289 | Here is a more complicated example that combines several |
| 1273 | aforementioned features: | 1290 | aforementioned features: |
| 1274 | 1291 | ||
| @@ -461,6 +461,16 @@ In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to | |||
| 461 | The old names, which were kept as obsolete aliases of the new names, | 461 | The old names, which were kept as obsolete aliases of the new names, |
| 462 | have now been removed. | 462 | have now been removed. |
| 463 | 463 | ||
| 464 | ** Battery | ||
| 465 | |||
| 466 | --- | ||
| 467 | *** A richer syntax can be used to format battery status information. | ||
| 468 | The user options 'battery-mode-line-format' and | ||
| 469 | 'battery-echo-area-format' now support the full formatting syntax of | ||
| 470 | the function 'format-spec' documented under '(elisp) Custom Format | ||
| 471 | Strings'. The new syntax includes specifiers for padding and | ||
| 472 | truncation, amongst other things. | ||
| 473 | |||
| 464 | 474 | ||
| 465 | * New Modes and Packages in Emacs 28.1 | 475 | * New Modes and Packages in Emacs 28.1 |
| 466 | 476 | ||
| @@ -578,6 +588,13 @@ for encoding and decoding without having to bind | |||
| 578 | It controls, whether 'process-file' returns a string when a remote | 588 | It controls, whether 'process-file' returns a string when a remote |
| 579 | process is interrupted by a signal. | 589 | process is interrupted by a signal. |
| 580 | 590 | ||
| 591 | +++ | ||
| 592 | ** The behavior of 'format-spec' is now closer to that of 'format'. | ||
| 593 | In order for the two functions to behave more consistently, | ||
| 594 | 'format-spec' now pads and truncates based on string width rather than | ||
| 595 | length, and also supports format specifications that include a | ||
| 596 | truncating precision field, such as '%.2a'. | ||
| 597 | |||
| 581 | 598 | ||
| 582 | * Changes in Emacs 28.1 on Non-Free Operating Systems | 599 | * Changes in Emacs 28.1 on Non-Free Operating Systems |
| 583 | 600 | ||
diff --git a/lisp/battery.el b/lisp/battery.el index b8855a8ce37..38728196507 100644 --- a/lisp/battery.el +++ b/lisp/battery.el | |||
| @@ -121,7 +121,10 @@ string are substituted as defined by the current value of the variable | |||
| 121 | %p Battery load percentage | 121 | %p Battery load percentage |
| 122 | %m Remaining time (to charge or discharge) in minutes | 122 | %m Remaining time (to charge or discharge) in minutes |
| 123 | %h Remaining time (to charge or discharge) in hours | 123 | %h Remaining time (to charge or discharge) in hours |
| 124 | %t Remaining time (to charge or discharge) in the form `h:min'" | 124 | %t Remaining time (to charge or discharge) in the form `h:min' |
| 125 | |||
| 126 | The full `format-spec' formatting syntax is supported." | ||
| 127 | :link '(info-link "(elisp) Custom Format Strings") | ||
| 125 | :type '(choice string (const nil))) | 128 | :type '(choice string (const nil))) |
| 126 | 129 | ||
| 127 | (defvar battery-mode-line-string nil | 130 | (defvar battery-mode-line-string nil |
| @@ -153,7 +156,10 @@ string are substituted as defined by the current value of the variable | |||
| 153 | %p Battery load percentage | 156 | %p Battery load percentage |
| 154 | %m Remaining time (to charge or discharge) in minutes | 157 | %m Remaining time (to charge or discharge) in minutes |
| 155 | %h Remaining time (to charge or discharge) in hours | 158 | %h Remaining time (to charge or discharge) in hours |
| 156 | %t Remaining time (to charge or discharge) in the form `h:min'" | 159 | %t Remaining time (to charge or discharge) in the form `h:min' |
| 160 | |||
| 161 | The full `format-spec' formatting syntax is supported." | ||
| 162 | :link '(info-link "(elisp) Custom Format Strings") | ||
| 157 | :type '(choice string (const nil))) | 163 | :type '(choice string (const nil))) |
| 158 | 164 | ||
| 159 | (defcustom battery-update-interval 60 | 165 | (defcustom battery-update-interval 60 |
| @@ -823,13 +829,7 @@ The following %-sequences are provided: | |||
| 823 | 829 | ||
| 824 | (defun battery-format (format alist) | 830 | (defun battery-format (format alist) |
| 825 | "Substitute %-sequences in FORMAT." | 831 | "Substitute %-sequences in FORMAT." |
| 826 | (replace-regexp-in-string | 832 | (format-spec format alist 'delete)) |
| 827 | "%." | ||
| 828 | (lambda (str) | ||
| 829 | (let ((char (aref str 1))) | ||
| 830 | (if (eq char ?%) "%" | ||
| 831 | (or (cdr (assoc char alist)) "")))) | ||
| 832 | format t t)) | ||
| 833 | 833 | ||
| 834 | (defun battery-search-for-one-match-in-files (files regexp match-num) | 834 | (defun battery-search-for-one-match-in-files (files regexp match-num) |
| 835 | "Search REGEXP in the content of the files listed in FILES. | 835 | "Search REGEXP in the content of the files listed in FILES. |
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 0d481f4ac19..efb214088d8 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -1064,8 +1064,6 @@ corresponding command. | |||
| 1064 | Within CMD, %i denotes the input file(s), and %o denotes the | 1064 | Within CMD, %i denotes the input file(s), and %o denotes the |
| 1065 | output file. %i path(s) are relative, while %o is absolute.") | 1065 | output file. %i path(s) are relative, while %o is absolute.") |
| 1066 | 1066 | ||
| 1067 | (declare-function format-spec "format-spec.el" (format specification)) | ||
| 1068 | |||
| 1069 | ;;;###autoload | 1067 | ;;;###autoload |
| 1070 | (defun dired-do-compress-to () | 1068 | (defun dired-do-compress-to () |
| 1071 | "Compress selected files and directories to an archive. | 1069 | "Compress selected files and directories to an archive. |
| @@ -1073,7 +1071,6 @@ Prompt for the archive file name. | |||
| 1073 | Choose the archiving command based on the archive file-name extension | 1071 | Choose the archiving command based on the archive file-name extension |
| 1074 | and `dired-compress-files-alist'." | 1072 | and `dired-compress-files-alist'." |
| 1075 | (interactive) | 1073 | (interactive) |
| 1076 | (require 'format-spec) | ||
| 1077 | (let* ((in-files (dired-get-marked-files nil nil nil nil t)) | 1074 | (let* ((in-files (dired-get-marked-files nil nil nil nil t)) |
| 1078 | (out-file (expand-file-name (read-file-name "Compress to: "))) | 1075 | (out-file (expand-file-name (read-file-name "Compress to: "))) |
| 1079 | (rule (cl-find-if | 1076 | (rule (cl-find-if |
| @@ -1093,12 +1090,12 @@ and `dired-compress-files-alist'." | |||
| 1093 | (when (zerop | 1090 | (when (zerop |
| 1094 | (dired-shell-command | 1091 | (dired-shell-command |
| 1095 | (format-spec (cdr rule) | 1092 | (format-spec (cdr rule) |
| 1096 | `((?\o . ,(shell-quote-argument out-file)) | 1093 | `((?o . ,(shell-quote-argument out-file)) |
| 1097 | (?\i . ,(mapconcat | 1094 | (?i . ,(mapconcat |
| 1098 | (lambda (file-desc) | 1095 | (lambda (in-file) |
| 1099 | (shell-quote-argument (file-name-nondirectory | 1096 | (shell-quote-argument |
| 1100 | file-desc))) | 1097 | (file-name-nondirectory in-file))) |
| 1101 | in-files " ")))))) | 1098 | in-files " ")))))) |
| 1102 | (message (ngettext "Compressed %d file to %s" | 1099 | (message (ngettext "Compressed %d file to %s" |
| 1103 | "Compressed %d files to %s" | 1100 | "Compressed %d files to %s" |
| 1104 | (length in-files)) | 1101 | (length in-files)) |
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 3107ff2ccd1..0e98f2bc613 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el | |||
| @@ -555,16 +555,15 @@ See `erc-log-match-format'." | |||
| 555 | (and (eq erc-log-matches-flag 'away) | 555 | (and (eq erc-log-matches-flag 'away) |
| 556 | (erc-away-time))) | 556 | (erc-away-time))) |
| 557 | match-buffer-name) | 557 | match-buffer-name) |
| 558 | (let ((line (format-spec erc-log-match-format | 558 | (let ((line (format-spec |
| 559 | (format-spec-make | 559 | erc-log-match-format |
| 560 | ?n nick | 560 | `((?n . ,nick) |
| 561 | ?t (format-time-string | 561 | (?t . ,(format-time-string |
| 562 | (or (and (boundp 'erc-timestamp-format) | 562 | (or (bound-and-true-p erc-timestamp-format) |
| 563 | erc-timestamp-format) | 563 | "[%Y-%m-%d %H:%M] "))) |
| 564 | "[%Y-%m-%d %H:%M] ")) | 564 | (?c . ,(or (erc-default-target) "")) |
| 565 | ?c (or (erc-default-target) "") | 565 | (?m . ,message) |
| 566 | ?m message | 566 | (?u . ,nickuserhost))))) |
| 567 | ?u nickuserhost)))) | ||
| 568 | (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) | 567 | (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) |
| 569 | (let ((inhibit-read-only t)) | 568 | (let ((inhibit-read-only t)) |
| 570 | (goto-char (point-max)) | 569 | (goto-char (point-max)) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cfde84e19aa..38807787945 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -6391,17 +6391,16 @@ if `erc-away' is non-nil." | |||
| 6391 | (defun erc-update-mode-line-buffer (buffer) | 6391 | (defun erc-update-mode-line-buffer (buffer) |
| 6392 | "Update the mode line in a single ERC buffer BUFFER." | 6392 | "Update the mode line in a single ERC buffer BUFFER." |
| 6393 | (with-current-buffer buffer | 6393 | (with-current-buffer buffer |
| 6394 | (let ((spec (format-spec-make | 6394 | (let ((spec `((?a . ,(erc-format-away-status)) |
| 6395 | ?a (erc-format-away-status) | 6395 | (?l . ,(erc-format-lag-time)) |
| 6396 | ?l (erc-format-lag-time) | 6396 | (?m . ,(erc-format-channel-modes)) |
| 6397 | ?m (erc-format-channel-modes) | 6397 | (?n . ,(or (erc-current-nick) "")) |
| 6398 | ?n (or (erc-current-nick) "") | 6398 | (?N . ,(erc-format-network)) |
| 6399 | ?N (erc-format-network) | 6399 | (?o . ,(or (erc-controls-strip erc-channel-topic) "")) |
| 6400 | ?o (or (erc-controls-strip erc-channel-topic) "") | 6400 | (?p . ,(erc-port-to-string erc-session-port)) |
| 6401 | ?p (erc-port-to-string erc-session-port) | 6401 | (?s . ,(erc-format-target-and/or-server)) |
| 6402 | ?s (erc-format-target-and/or-server) | 6402 | (?S . ,(erc-format-target-and/or-network)) |
| 6403 | ?S (erc-format-target-and/or-network) | 6403 | (?t . ,(erc-format-target)))) |
| 6404 | ?t (erc-format-target))) | ||
| 6405 | (process-status (cond ((and (erc-server-process-alive) | 6404 | (process-status (cond ((and (erc-server-process-alive) |
| 6406 | (not erc-server-connected)) | 6405 | (not erc-server-connected)) |
| 6407 | ":connecting") | 6406 | ":connecting") |
diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 9278bd74c42..6af79a44167 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; format-spec.el --- functions for formatting arbitrary formatting strings | 1 | ;;; format-spec.el --- format arbitrary formatting strings -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -24,10 +24,8 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (eval-when-compile | 27 | ;;;###autoload |
| 28 | (require 'subr-x)) | 28 | (defun format-spec (format specification &optional ignore-missing) |
| 29 | |||
| 30 | (defun format-spec (format specification &optional only-present) | ||
| 31 | "Return a string based on FORMAT and SPECIFICATION. | 29 | "Return a string based on FORMAT and SPECIFICATION. |
| 32 | FORMAT is a string containing `format'-like specs like \"su - %u %k\". | 30 | FORMAT is a string containing `format'-like specs like \"su - %u %k\". |
| 33 | SPECIFICATION is an alist mapping format specification characters | 31 | SPECIFICATION is an alist mapping format specification characters |
| @@ -39,22 +37,22 @@ For instance: | |||
| 39 | \\=`((?u . ,(user-login-name)) | 37 | \\=`((?u . ,(user-login-name)) |
| 40 | (?l . \"ls\"))) | 38 | (?l . \"ls\"))) |
| 41 | 39 | ||
| 42 | Each %-spec may contain optional flag and width modifiers, as | 40 | Each %-spec may contain optional flag, width, and precision |
| 43 | follows: | 41 | modifiers, as follows: |
| 44 | 42 | ||
| 45 | %<flags><width>character | 43 | %<flags><width><precision>character |
| 46 | 44 | ||
| 47 | The following flags are allowed: | 45 | The following flags are allowed: |
| 48 | 46 | ||
| 49 | * 0: Pad to the width, if given, with zeros instead of spaces. | 47 | * 0: Pad to the width, if given, with zeros instead of spaces. |
| 50 | * -: Pad to the width, if given, on the right instead of the left. | 48 | * -: Pad to the width, if given, on the right instead of the left. |
| 51 | * <: Truncate to the width, if given, on the left. | 49 | * <: Truncate to the width and precision, if given, on the left. |
| 52 | * >: Truncate to the width, if given, on the right. | 50 | * >: Truncate to the width and precision, if given, on the right. |
| 53 | * ^: Convert to upper case. | 51 | * ^: Convert to upper case. |
| 54 | * _: Convert to lower case. | 52 | * _: Convert to lower case. |
| 55 | 53 | ||
| 56 | The width modifier behaves like the corresponding one in `format' | 54 | The width and truncation modifiers behave like the corresponding |
| 57 | when applied to %s. | 55 | ones in `format' when applied to %s. |
| 58 | 56 | ||
| 59 | For example, \"%<010b\" means \"substitute into the output the | 57 | For example, \"%<010b\" means \"substitute into the output the |
| 60 | value associated with ?b in SPECIFICATION, either padding it with | 58 | value associated with ?b in SPECIFICATION, either padding it with |
| @@ -64,89 +62,108 @@ characters wide\". | |||
| 64 | Any text properties of FORMAT are copied to the result, with any | 62 | Any text properties of FORMAT are copied to the result, with any |
| 65 | text properties of a %-spec itself copied to its substitution. | 63 | text properties of a %-spec itself copied to its substitution. |
| 66 | 64 | ||
| 67 | ONLY-PRESENT indicates how to handle %-spec characters not | 65 | IGNORE-MISSING indicates how to handle %-spec characters not |
| 68 | present in SPECIFICATION. If it is nil or omitted, emit an | 66 | present in SPECIFICATION. If it is nil or omitted, emit an |
| 69 | error; otherwise leave those %-specs and any occurrences of | 67 | error; if it is the symbol `ignore', leave those %-specs verbatim |
| 70 | \"%%\" in FORMAT verbatim in the result, including their text | 68 | in the result, including their text properties, if any; if it is |
| 71 | properties, if any." | 69 | the symbol `delete', remove those %-specs from the result; |
| 70 | otherwise do the same as for the symbol `ignore', but also leave | ||
| 71 | any occurrences of \"%%\" in FORMAT verbatim in the result." | ||
| 72 | (with-temp-buffer | 72 | (with-temp-buffer |
| 73 | (insert format) | 73 | (insert format) |
| 74 | (goto-char (point-min)) | 74 | (goto-char (point-min)) |
| 75 | (while (search-forward "%" nil t) | 75 | (while (search-forward "%" nil t) |
| 76 | (cond | 76 | (cond |
| 77 | ;; Quoted percent sign. | 77 | ;; Quoted percent sign. |
| 78 | ((eq (char-after) ?%) | 78 | ((= (following-char) ?%) |
| 79 | (unless only-present | 79 | (when (memq ignore-missing '(nil ignore delete)) |
| 80 | (delete-char 1))) | 80 | (delete-char 1))) |
| 81 | ;; Valid format spec. | 81 | ;; Valid format spec. |
| 82 | ((looking-at "\\([-0 _^<>]*\\)\\([0-9.]*\\)\\([a-zA-Z]\\)") | 82 | ((looking-at (rx (? (group (+ (in " 0<>^_-")))) |
| 83 | (let* ((modifiers (match-string 1)) | 83 | (? (group (+ digit))) |
| 84 | (num (match-string 2)) | 84 | (? (group ?. (+ digit))) |
| 85 | (spec (string-to-char (match-string 3))) | 85 | (group alpha))) |
| 86 | (val (assq spec specification))) | 86 | (let* ((beg (point)) |
| 87 | (if (not val) | 87 | (end (match-end 0)) |
| 88 | (unless only-present | 88 | (flags (match-string 1)) |
| 89 | (error "Invalid format character: `%%%c'" spec)) | 89 | (width (match-string 2)) |
| 90 | (setq val (cdr val) | 90 | (trunc (match-string 3)) |
| 91 | modifiers (format-spec--parse-modifiers modifiers)) | 91 | (char (string-to-char (match-string 4))) |
| 92 | ;; Pad result to desired length. | 92 | (text (assq char specification))) |
| 93 | (let ((text (format "%s" val))) | 93 | (cond (text |
| 94 | (when num | 94 | ;; Handle flags. |
| 95 | (setq num (string-to-number num)) | 95 | (setq text (format-spec--do-flags |
| 96 | (setq text (format-spec--pad text num modifiers)) | 96 | (format "%s" (cdr text)) |
| 97 | (when (> (length text) num) | 97 | (format-spec--parse-flags flags) |
| 98 | (cond | 98 | (and width (string-to-number width)) |
| 99 | ((memq :chop-left modifiers) | 99 | (and trunc (car (read-from-string trunc 1))))) |
| 100 | (setq text (substring text (- (length text) num)))) | 100 | ;; Insert first, to preserve text properties. |
| 101 | ((memq :chop-right modifiers) | 101 | (insert-and-inherit text) |
| 102 | (setq text (substring text 0 num)))))) | 102 | ;; Delete the specifier body. |
| 103 | (when (memq :uppercase modifiers) | 103 | (delete-region (point) (+ end (length text))) |
| 104 | (setq text (upcase text))) | 104 | ;; Delete the percent sign. |
| 105 | (when (memq :lowercase modifiers) | 105 | (delete-region (1- beg) beg)) |
| 106 | (setq text (downcase text))) | 106 | ((eq ignore-missing 'delete) |
| 107 | ;; Insert first, to preserve text properties. | 107 | ;; Delete the whole format spec. |
| 108 | (insert-and-inherit text) | 108 | (delete-region (1- beg) end)) |
| 109 | ;; Delete the specifier body. | 109 | ((not ignore-missing) |
| 110 | (delete-region (+ (match-beginning 0) (length text)) | 110 | (error "Invalid format character: `%%%c'" char))))) |
| 111 | (+ (match-end 0) (length text))) | 111 | ;; Signal an error on bogus format strings. |
| 112 | ;; Delete the percent sign. | 112 | ((not ignore-missing) |
| 113 | (delete-region (1- (match-beginning 0)) (match-beginning 0)))))) | 113 | (error "Invalid format string")))) |
| 114 | ;; Signal an error on bogus format strings. | ||
| 115 | (t | ||
| 116 | (unless only-present | ||
| 117 | (error "Invalid format string"))))) | ||
| 118 | (buffer-string))) | 114 | (buffer-string))) |
| 119 | 115 | ||
| 120 | (defun format-spec--pad (text total-length modifiers) | 116 | (defun format-spec--do-flags (str flags width trunc) |
| 121 | (if (> (length text) total-length) | 117 | "Return STR formatted according to FLAGS, WIDTH, and TRUNC. |
| 122 | ;; The text is longer than the specified length; do nothing. | 118 | FLAGS is a list of keywords as returned by |
| 123 | text | 119 | `format-spec--parse-flags'. WIDTH and TRUNC are either nil or |
| 124 | (let ((padding (make-string (- total-length (length text)) | 120 | string widths corresponding to `format-spec' modifiers." |
| 125 | (if (memq :zero-pad modifiers) | 121 | (let (diff str-width) |
| 126 | ?0 | 122 | ;; Truncate original string first, like `format' does. |
| 127 | ?\s)))) | 123 | (when trunc |
| 128 | (if (memq :right-pad modifiers) | 124 | (setq str-width (string-width str)) |
| 129 | (concat text padding) | 125 | (when (> (setq diff (- str-width trunc)) 0) |
| 130 | (concat padding text))))) | 126 | (setq str (if (memq :chop-left flags) |
| 131 | 127 | (truncate-string-to-width str str-width diff) | |
| 132 | (defun format-spec--parse-modifiers (modifiers) | 128 | (format (format "%%.%ds" trunc) str)) |
| 129 | ;; We know the new width so save it for later. | ||
| 130 | str-width trunc))) | ||
| 131 | ;; Pad or chop to width. | ||
| 132 | (when width | ||
| 133 | (setq str-width (or str-width (string-width str)) | ||
| 134 | diff (- width str-width)) | ||
| 135 | (cond ((zerop diff)) | ||
| 136 | ((> diff 0) | ||
| 137 | (let ((pad (make-string diff (if (memq :pad-zero flags) ?0 ?\s)))) | ||
| 138 | (setq str (if (memq :pad-right flags) | ||
| 139 | (concat str pad) | ||
| 140 | (concat pad str))))) | ||
| 141 | ((memq :chop-left flags) | ||
| 142 | (setq str (truncate-string-to-width str str-width (- diff)))) | ||
| 143 | ((memq :chop-right flags) | ||
| 144 | (setq str (format (format "%%.%ds" width) str)))))) | ||
| 145 | ;; Fiddle case. | ||
| 146 | (cond ((memq :upcase flags) | ||
| 147 | (upcase str)) | ||
| 148 | ((memq :downcase flags) | ||
| 149 | (downcase str)) | ||
| 150 | (str))) | ||
| 151 | |||
| 152 | (defun format-spec--parse-flags (flags) | ||
| 153 | "Convert sequence of FLAGS to list of human-readable keywords." | ||
| 133 | (mapcan (lambda (char) | 154 | (mapcan (lambda (char) |
| 134 | (when-let ((modifier | 155 | (pcase char |
| 135 | (pcase char | 156 | (?0 (list :pad-zero)) |
| 136 | (?0 :zero-pad) | 157 | (?- (list :pad-right)) |
| 137 | (?\s :space-pad) | 158 | (?< (list :chop-left)) |
| 138 | (?^ :uppercase) | 159 | (?> (list :chop-right)) |
| 139 | (?_ :lowercase) | 160 | (?^ (list :upcase)) |
| 140 | (?- :right-pad) | 161 | (?_ (list :downcase)))) |
| 141 | (?< :chop-left) | 162 | flags)) |
| 142 | (?> :chop-right)))) | ||
| 143 | (list modifier))) | ||
| 144 | modifiers)) | ||
| 145 | 163 | ||
| 146 | (defun format-spec-make (&rest pairs) | 164 | (defun format-spec-make (&rest pairs) |
| 147 | "Return an alist suitable for use in `format-spec' based on PAIRS. | 165 | "Return an alist suitable for use in `format-spec' based on PAIRS. |
| 148 | PAIRS is a list where every other element is a character and a value, | 166 | PAIRS is a property list with characters as keys." |
| 149 | starting with a character." | ||
| 150 | (let (alist) | 167 | (let (alist) |
| 151 | (while pairs | 168 | (while pairs |
| 152 | (unless (cdr pairs) | 169 | (unless (cdr pairs) |
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index 278e3a5d6f3..5d8f9b55deb 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el | |||
| @@ -29,8 +29,6 @@ | |||
| 29 | 29 | ||
| 30 | (require 'gnus) | 30 | (require 'gnus) |
| 31 | (require 'gnus-sum) | 31 | (require 'gnus-sum) |
| 32 | (require 'format-spec) | ||
| 33 | (autoload 'sieve-mode "sieve-mode") | ||
| 34 | (eval-when-compile | 32 | (eval-when-compile |
| 35 | (require 'sieve)) | 33 | (require 'sieve)) |
| 36 | 34 | ||
| @@ -88,10 +86,10 @@ See the documentation for these variables and functions for details." | |||
| 88 | (save-buffer) | 86 | (save-buffer) |
| 89 | (shell-command | 87 | (shell-command |
| 90 | (format-spec gnus-sieve-update-shell-command | 88 | (format-spec gnus-sieve-update-shell-command |
| 91 | (format-spec-make ?f gnus-sieve-file | 89 | `((?f . ,gnus-sieve-file) |
| 92 | ?s (or (cadr (gnus-server-get-method | 90 | (?s . ,(or (cadr (gnus-server-get-method |
| 93 | nil gnus-sieve-select-method)) | 91 | nil gnus-sieve-select-method)) |
| 94 | ""))))) | 92 | "")))))) |
| 95 | 93 | ||
| 96 | ;;;###autoload | 94 | ;;;###autoload |
| 97 | (defun gnus-sieve-generate () | 95 | (defun gnus-sieve-generate () |
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index 218a1542e3a..485d58ad94e 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el | |||
| @@ -25,8 +25,6 @@ | |||
| 25 | 25 | ||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (require 'format-spec) | ||
| 29 | |||
| 30 | (defcustom gssapi-program (list | 28 | (defcustom gssapi-program (list |
| 31 | (concat "gsasl %s %p " | 29 | (concat "gsasl %s %p " |
| 32 | "--mechanism GSSAPI " | 30 | "--mechanism GSSAPI " |
| @@ -53,12 +51,9 @@ tried until a successful connection is made." | |||
| 53 | (coding-system-for-write 'binary) | 51 | (coding-system-for-write 'binary) |
| 54 | (process (start-process | 52 | (process (start-process |
| 55 | name buffer shell-file-name shell-command-switch | 53 | name buffer shell-file-name shell-command-switch |
| 56 | (format-spec | 54 | (format-spec cmd `((?s . ,server) |
| 57 | cmd | 55 | (?p . ,(number-to-string port)) |
| 58 | (format-spec-make | 56 | (?l . ,user))))) |
| 59 | ?s server | ||
| 60 | ?p (number-to-string port) | ||
| 61 | ?l user)))) | ||
| 62 | response) | 57 | response) |
| 63 | (when process | 58 | (when process |
| 64 | (while (and (memq (process-status process) '(open run)) | 59 | (while (and (memq (process-status process) '(open run)) |
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index acf35a376a9..43180726c45 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el | |||
| @@ -24,7 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (require 'format-spec) | ||
| 28 | (eval-when-compile | 27 | (eval-when-compile |
| 29 | (require 'cl-lib) | 28 | (require 'cl-lib) |
| 30 | (require 'imap)) | 29 | (require 'imap)) |
| @@ -769,14 +768,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 769 | "Fetcher for single-file sources." | 768 | "Fetcher for single-file sources." |
| 770 | (mail-source-bind (file source) | 769 | (mail-source-bind (file source) |
| 771 | (mail-source-run-script | 770 | (mail-source-run-script |
| 772 | prescript (format-spec-make ?t mail-source-crash-box) | 771 | prescript `((?t . ,mail-source-crash-box)) |
| 773 | prescript-delay) | 772 | prescript-delay) |
| 774 | (let ((mail-source-string (format "file:%s" path))) | 773 | (let ((mail-source-string (format "file:%s" path))) |
| 775 | (if (mail-source-movemail path mail-source-crash-box) | 774 | (if (mail-source-movemail path mail-source-crash-box) |
| 776 | (prog1 | 775 | (prog1 |
| 777 | (mail-source-callback callback path) | 776 | (mail-source-callback callback path) |
| 778 | (mail-source-run-script | 777 | (mail-source-run-script |
| 779 | postscript (format-spec-make ?t mail-source-crash-box)) | 778 | postscript `((?t . ,mail-source-crash-box))) |
| 780 | (mail-source-delete-crash-box)) | 779 | (mail-source-delete-crash-box)) |
| 781 | 0)))) | 780 | 0)))) |
| 782 | 781 | ||
| @@ -784,7 +783,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 784 | "Fetcher for directory sources." | 783 | "Fetcher for directory sources." |
| 785 | (mail-source-bind (directory source) | 784 | (mail-source-bind (directory source) |
| 786 | (mail-source-run-script | 785 | (mail-source-run-script |
| 787 | prescript (format-spec-make ?t path) prescript-delay) | 786 | prescript `((?t . ,path)) prescript-delay) |
| 788 | (let ((found 0) | 787 | (let ((found 0) |
| 789 | (mail-source-string (format "directory:%s" path))) | 788 | (mail-source-string (format "directory:%s" path))) |
| 790 | (dolist (file (directory-files | 789 | (dolist (file (directory-files |
| @@ -793,7 +792,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 793 | (funcall predicate file) | 792 | (funcall predicate file) |
| 794 | (mail-source-movemail file mail-source-crash-box)) | 793 | (mail-source-movemail file mail-source-crash-box)) |
| 795 | (cl-incf found (mail-source-callback callback file)) | 794 | (cl-incf found (mail-source-callback callback file)) |
| 796 | (mail-source-run-script postscript (format-spec-make ?t path)) | 795 | (mail-source-run-script postscript `((?t . ,path))) |
| 797 | (mail-source-delete-crash-box))) | 796 | (mail-source-delete-crash-box))) |
| 798 | found))) | 797 | found))) |
| 799 | 798 | ||
| @@ -803,8 +802,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 803 | ;; fixme: deal with stream type in format specs | 802 | ;; fixme: deal with stream type in format specs |
| 804 | (mail-source-run-script | 803 | (mail-source-run-script |
| 805 | prescript | 804 | prescript |
| 806 | (format-spec-make ?p password ?t mail-source-crash-box | 805 | `((?p . ,password) (?t . ,mail-source-crash-box) |
| 807 | ?s server ?P port ?u user) | 806 | (?s . ,server) (?P . ,port) (?u . ,user)) |
| 808 | prescript-delay) | 807 | prescript-delay) |
| 809 | (let ((from (format "%s:%s:%s" server user port)) | 808 | (let ((from (format "%s:%s:%s" server user port)) |
| 810 | (mail-source-string (format "pop:%s@%s" user server)) | 809 | (mail-source-string (format "pop:%s@%s" user server)) |
| @@ -825,8 +824,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 825 | (mail-source-fetch-with-program | 824 | (mail-source-fetch-with-program |
| 826 | (format-spec | 825 | (format-spec |
| 827 | program | 826 | program |
| 828 | (format-spec-make ?p password ?t mail-source-crash-box | 827 | `((?p . ,password) (?t . ,mail-source-crash-box) |
| 829 | ?s server ?P port ?u user)))) | 828 | (?s . ,server) (?P . ,port) (?u . ,user))))) |
| 830 | (function | 829 | (function |
| 831 | (funcall function mail-source-crash-box)) | 830 | (funcall function mail-source-crash-box)) |
| 832 | ;; The default is to use pop3.el. | 831 | ;; The default is to use pop3.el. |
| @@ -863,8 +862,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) | |||
| 863 | (setq mail-source-new-mail-available nil)) | 862 | (setq mail-source-new-mail-available nil)) |
| 864 | (mail-source-run-script | 863 | (mail-source-run-script |
| 865 | postscript | 864 | postscript |
| 866 | (format-spec-make ?p password ?t mail-source-crash-box | 865 | `((?p . ,password) (?t . ,mail-source-crash-box) |
| 867 | ?s server ?P port ?u user)) | 866 | (?s . ,server) (?P . ,port) (?u . ,user))) |
| 868 | (mail-source-delete-crash-box))) | 867 | (mail-source-delete-crash-box))) |
| 869 | ;; We nix out the password in case the error | 868 | ;; We nix out the password in case the error |
| 870 | ;; was because of a wrong password being given. | 869 | ;; was because of a wrong password being given. |
| @@ -1077,8 +1076,9 @@ This only works when `display-time' is enabled." | |||
| 1077 | "Fetcher for imap sources." | 1076 | "Fetcher for imap sources." |
| 1078 | (mail-source-bind (imap source) | 1077 | (mail-source-bind (imap source) |
| 1079 | (mail-source-run-script | 1078 | (mail-source-run-script |
| 1080 | prescript (format-spec-make ?p password ?t mail-source-crash-box | 1079 | prescript |
| 1081 | ?s server ?P port ?u user) | 1080 | `((?p . ,password) (?t . ,mail-source-crash-box) |
| 1081 | (?s . ,server) (?P . ,port) (?u . ,user)) | ||
| 1082 | prescript-delay) | 1082 | prescript-delay) |
| 1083 | (let ((from (format "%s:%s:%s" server user port)) | 1083 | (let ((from (format "%s:%s:%s" server user port)) |
| 1084 | (found 0) | 1084 | (found 0) |
| @@ -1143,8 +1143,8 @@ This only works when `display-time' is enabled." | |||
| 1143 | (kill-buffer buf) | 1143 | (kill-buffer buf) |
| 1144 | (mail-source-run-script | 1144 | (mail-source-run-script |
| 1145 | postscript | 1145 | postscript |
| 1146 | (format-spec-make ?p password ?t mail-source-crash-box | 1146 | `((?p . ,password) (?t . ,mail-source-crash-box) |
| 1147 | ?s server ?P port ?u user)) | 1147 | (?s . ,server) (?P . ,port) (?u . ,user))) |
| 1148 | found))) | 1148 | found))) |
| 1149 | 1149 | ||
| 1150 | (provide 'mail-source) | 1150 | (provide 'mail-source) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5a6827af762..fb560f0eab8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -42,13 +42,12 @@ | |||
| 42 | (require 'mail-parse) | 42 | (require 'mail-parse) |
| 43 | (require 'mml) | 43 | (require 'mml) |
| 44 | (require 'rfc822) | 44 | (require 'rfc822) |
| 45 | (require 'format-spec) | ||
| 46 | (require 'dired) | 45 | (require 'dired) |
| 47 | (require 'mm-util) | 46 | (require 'mm-util) |
| 48 | (require 'rfc2047) | 47 | (require 'rfc2047) |
| 49 | (require 'puny) | 48 | (require 'puny) |
| 50 | (require 'rmc) ; read-multiple-choice | 49 | (require 'rmc) ; read-multiple-choice |
| 51 | (eval-when-compile (require 'subr-x)) ; when-let* | 50 | (eval-when-compile (require 'subr-x)) |
| 52 | 51 | ||
| 53 | (autoload 'mailclient-send-it "mailclient") | 52 | (autoload 'mailclient-send-it "mailclient") |
| 54 | 53 | ||
| @@ -440,8 +439,8 @@ whitespace)." | |||
| 440 | 439 | ||
| 441 | (defcustom message-elide-ellipsis "\n[...]\n\n" | 440 | (defcustom message-elide-ellipsis "\n[...]\n\n" |
| 442 | "The string which is inserted for elided text. | 441 | "The string which is inserted for elided text. |
| 443 | This is a format-spec string, and you can use %l to say how many | 442 | This is a `format-spec' string, and you can use %l to say how |
| 444 | lines were removed, and %c to say how many characters were | 443 | many lines were removed, and %c to say how many characters were |
| 445 | removed." | 444 | removed." |
| 446 | :type 'string | 445 | :type 'string |
| 447 | :link '(custom-manual "(message)Various Commands") | 446 | :link '(custom-manual "(message)Various Commands") |
| @@ -3977,7 +3976,6 @@ This function uses `mail-citation-hook' if that is non-nil." | |||
| 3977 | "Cite function in the standard Message manner." | 3976 | "Cite function in the standard Message manner." |
| 3978 | (message-cite-original-1 nil)) | 3977 | (message-cite-original-1 nil)) |
| 3979 | 3978 | ||
| 3980 | (autoload 'format-spec "format-spec") | ||
| 3981 | (autoload 'gnus-date-get-time "gnus-util") | 3979 | (autoload 'gnus-date-get-time "gnus-util") |
| 3982 | 3980 | ||
| 3983 | (defun message-insert-formatted-citation-line (&optional from date tz) | 3981 | (defun message-insert-formatted-citation-line (&optional from date tz) |
| @@ -4002,20 +4000,18 @@ See `message-citation-line-format'." | |||
| 4002 | (when (or message-reply-headers (and from date)) | 4000 | (when (or message-reply-headers (and from date)) |
| 4003 | (unless from | 4001 | (unless from |
| 4004 | (setq from (mail-header-from message-reply-headers))) | 4002 | (setq from (mail-header-from message-reply-headers))) |
| 4005 | (let* ((data (condition-case () | 4003 | (let* ((data (ignore-errors |
| 4006 | (funcall (if (boundp 'gnus-extract-address-components) | 4004 | (funcall (or (bound-and-true-p |
| 4007 | gnus-extract-address-components | 4005 | gnus-extract-address-components) |
| 4008 | 'mail-extract-address-components) | 4006 | #'mail-extract-address-components) |
| 4009 | from) | 4007 | from))) |
| 4010 | (error nil))) | ||
| 4011 | (name (car data)) | 4008 | (name (car data)) |
| 4012 | (fname name) | 4009 | (fname name) |
| 4013 | (lname name) | 4010 | (lname name) |
| 4014 | (net (car (cdr data))) | 4011 | (net (cadr data)) |
| 4015 | (name-or-net (or (car data) | 4012 | (name-or-net (or name net from)) |
| 4016 | (car (cdr data)) from)) | ||
| 4017 | (time | 4013 | (time |
| 4018 | (when (string-match "%[^fnNFL]" message-citation-line-format) | 4014 | (when (string-match-p "%[^FLNfn]" message-citation-line-format) |
| 4019 | (cond ((numberp (car-safe date)) date) ;; backward compatibility | 4015 | (cond ((numberp (car-safe date)) date) ;; backward compatibility |
| 4020 | (date (gnus-date-get-time date)) | 4016 | (date (gnus-date-get-time date)) |
| 4021 | (t | 4017 | (t |
| @@ -4024,68 +4020,53 @@ See `message-citation-line-format'." | |||
| 4024 | (tz (or tz | 4020 | (tz (or tz |
| 4025 | (when (stringp date) | 4021 | (when (stringp date) |
| 4026 | (nth 8 (parse-time-string date))))) | 4022 | (nth 8 (parse-time-string date))))) |
| 4027 | (flist | 4023 | spec) |
| 4028 | (let ((i ?A) lst) | 4024 | (when (stringp name) |
| 4029 | (when (stringp name) | 4025 | ;; Guess first name and last name: |
| 4030 | ;; Guess first name and last name: | 4026 | (let* ((names (seq-filter |
| 4031 | (let* ((names (delq | 4027 | (lambda (s) |
| 4032 | nil | 4028 | (string-match-p (rx bos (+ (in word ?. ?-)) eos) s)) |
| 4033 | (mapcar | 4029 | (split-string name "[ \t]+"))) |
| 4034 | (lambda (x) | 4030 | (count (length names))) |
| 4035 | (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" | 4031 | (cond ((= count 1) |
| 4036 | x) | 4032 | (setq fname (car names) |
| 4037 | x | 4033 | lname "")) |
| 4038 | nil)) | 4034 | ((or (= count 2) (= count 3)) |
| 4039 | (split-string name "[ \t]+")))) | 4035 | (setq fname (car names) |
| 4040 | (count (length names))) | 4036 | lname (string-join (cdr names) " "))) |
| 4041 | (cond ((= count 1) | 4037 | ((> count 3) |
| 4042 | (setq fname (car names) | 4038 | (setq fname (string-join (butlast names (- count 2)) |
| 4043 | lname "")) | 4039 | " ") |
| 4044 | ((or (= count 2) (= count 3)) | 4040 | lname (string-join (nthcdr 2 names) " ")))) |
| 4045 | (setq fname (car names) | 4041 | (when (string-match "\\(.*\\),\\'" fname) |
| 4046 | lname (mapconcat 'identity (cdr names) " "))) | 4042 | (let ((newlname (match-string 1 fname))) |
| 4047 | ((> count 3) | 4043 | (setq fname lname lname newlname))))) |
| 4048 | (setq fname (mapconcat 'identity | 4044 | ;; The following letters are not used in `format-time-string': |
| 4049 | (butlast names (- count 2)) | 4045 | (push (cons ?E "<E>") spec) |
| 4050 | " ") | 4046 | (push (cons ?F (or fname name-or-net)) spec) |
| 4051 | lname (mapconcat 'identity | 4047 | ;; We might want to use "" instead of "<X>" later. |
| 4052 | (nthcdr 2 names) | 4048 | (push (cons ?J "<J>") spec) |
| 4053 | " ")))) | 4049 | (push (cons ?K "<K>") spec) |
| 4054 | (when (string-match "\\(.*\\),\\'" fname) | 4050 | (push (cons ?L lname) spec) |
| 4055 | (let ((newlname (match-string 1 fname))) | 4051 | (push (cons ?N name-or-net) spec) |
| 4056 | (setq fname lname lname newlname))))) | 4052 | (push (cons ?O "<O>") spec) |
| 4057 | ;; The following letters are not used in `format-time-string': | 4053 | (push (cons ?P "<P>") spec) |
| 4058 | (push ?E lst) (push "<E>" lst) | 4054 | (push (cons ?Q "<Q>") spec) |
| 4059 | (push ?F lst) (push (or fname name-or-net) lst) | 4055 | (push (cons ?f from) spec) |
| 4060 | ;; We might want to use "" instead of "<X>" later. | 4056 | (push (cons ?i "<i>") spec) |
| 4061 | (push ?J lst) (push "<J>" lst) | 4057 | (push (cons ?n net) spec) |
| 4062 | (push ?K lst) (push "<K>" lst) | 4058 | (push (cons ?o "<o>") spec) |
| 4063 | (push ?L lst) (push lname lst) | 4059 | (push (cons ?q "<q>") spec) |
| 4064 | (push ?N lst) (push name-or-net lst) | 4060 | (push (cons ?t "<t>") spec) |
| 4065 | (push ?O lst) (push "<O>" lst) | 4061 | (push (cons ?v "<v>") spec) |
| 4066 | (push ?P lst) (push "<P>" lst) | 4062 | ;; Delegate the rest to `format-time-string': |
| 4067 | (push ?Q lst) (push "<Q>" lst) | 4063 | (dolist (c (nconc (number-sequence ?A ?Z) |
| 4068 | (push ?f lst) (push from lst) | 4064 | (number-sequence ?a ?z))) |
| 4069 | (push ?i lst) (push "<i>" lst) | 4065 | (unless (assq c spec) |
| 4070 | (push ?n lst) (push net lst) | 4066 | (push (cons c (condition-case nil |
| 4071 | (push ?o lst) (push "<o>" lst) | 4067 | (format-time-string (format "%%%c" c) time tz) |
| 4072 | (push ?q lst) (push "<q>" lst) | 4068 | (error (format ">%c<" c)))) |
| 4073 | (push ?t lst) (push "<t>" lst) | 4069 | spec))) |
| 4074 | (push ?v lst) (push "<v>" lst) | ||
| 4075 | ;; Delegate the rest to `format-time-string': | ||
| 4076 | (while (<= i ?z) | ||
| 4077 | (when (and (not (memq i lst)) | ||
| 4078 | ;; Skip (Z,a) | ||
| 4079 | (or (<= i ?Z) | ||
| 4080 | (>= i ?a))) | ||
| 4081 | (push i lst) | ||
| 4082 | (push (condition-case nil | ||
| 4083 | (format-time-string (format "%%%c" i) time tz) | ||
| 4084 | (error (format ">%c<" i))) | ||
| 4085 | lst)) | ||
| 4086 | (setq i (1+ i))) | ||
| 4087 | (reverse lst))) | ||
| 4088 | (spec (apply 'format-spec-make flist))) | ||
| 4089 | (insert (format-spec message-citation-line-format spec))) | 4070 | (insert (format-spec message-citation-line-format spec))) |
| 4090 | (newline))) | 4071 | (newline))) |
| 4091 | 4072 | ||
diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 1cc38ba714b..6f297672caf 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el | |||
| @@ -149,7 +149,6 @@ | |||
| 149 | ;;; Code: | 149 | ;;; Code: |
| 150 | 150 | ||
| 151 | (require 'dired) | 151 | (require 'dired) |
| 152 | (require 'format-spec) | ||
| 153 | (require 'image-mode) | 152 | (require 'image-mode) |
| 154 | (require 'widget) | 153 | (require 'widget) |
| 155 | 154 | ||
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2a70560ca7b..cf31d37f072 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -25,7 +25,6 @@ | |||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (require 'cl-lib) | 27 | (require 'cl-lib) |
| 28 | (require 'format-spec) | ||
| 29 | (require 'shr) | 28 | (require 'shr) |
| 30 | (require 'url) | 29 | (require 'url) |
| 31 | (require 'url-queue) | 30 | (require 'url-queue) |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index aa10f0291fd..a492dc8c798 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -136,7 +136,6 @@ | |||
| 136 | ;;; Code: | 136 | ;;; Code: |
| 137 | 137 | ||
| 138 | (eval-when-compile (require 'cl-lib)) | 138 | (eval-when-compile (require 'cl-lib)) |
| 139 | (require 'format-spec) | ||
| 140 | (require 'utf7) | 139 | (require 'utf7) |
| 141 | (require 'rfc2104) | 140 | (require 'rfc2104) |
| 142 | ;; Hmm... digest-md5 is not part of Emacs. | 141 | ;; Hmm... digest-md5 is not part of Emacs. |
| @@ -517,12 +516,9 @@ sure of changing the value of `foo'." | |||
| 517 | (process-connection-type imap-process-connection-type) | 516 | (process-connection-type imap-process-connection-type) |
| 518 | (process (start-process | 517 | (process (start-process |
| 519 | name buffer shell-file-name shell-command-switch | 518 | name buffer shell-file-name shell-command-switch |
| 520 | (format-spec | 519 | (format-spec cmd `((?s . ,server) |
| 521 | cmd | 520 | (?p . ,(number-to-string port)) |
| 522 | (format-spec-make | 521 | (?l . ,imap-default-user))))) |
| 523 | ?s server | ||
| 524 | ?p (number-to-string port) | ||
| 525 | ?l imap-default-user)))) | ||
| 526 | response) | 522 | response) |
| 527 | (when process | 523 | (when process |
| 528 | (with-current-buffer buffer | 524 | (with-current-buffer buffer |
| @@ -583,12 +579,9 @@ sure of changing the value of `foo'." | |||
| 583 | (process-connection-type imap-process-connection-type) | 579 | (process-connection-type imap-process-connection-type) |
| 584 | (process (start-process | 580 | (process (start-process |
| 585 | name buffer shell-file-name shell-command-switch | 581 | name buffer shell-file-name shell-command-switch |
| 586 | (format-spec | 582 | (format-spec cmd `((?s . ,server) |
| 587 | cmd | 583 | (?p . ,(number-to-string port)) |
| 588 | (format-spec-make | 584 | (?l . ,imap-default-user))))) |
| 589 | ?s server | ||
| 590 | ?p (number-to-string port) | ||
| 591 | ?l imap-default-user)))) | ||
| 592 | response) | 585 | response) |
| 593 | (when process | 586 | (when process |
| 594 | (with-current-buffer buffer | 587 | (with-current-buffer buffer |
| @@ -701,13 +694,10 @@ sure of changing the value of `foo'." | |||
| 701 | (process-connection-type imap-process-connection-type) | 694 | (process-connection-type imap-process-connection-type) |
| 702 | (process (start-process | 695 | (process (start-process |
| 703 | name buffer shell-file-name shell-command-switch | 696 | name buffer shell-file-name shell-command-switch |
| 704 | (format-spec | 697 | (format-spec cmd `((?s . ,server) |
| 705 | cmd | 698 | (?g . ,imap-shell-host) |
| 706 | (format-spec-make | 699 | (?p . ,(number-to-string port)) |
| 707 | ?s server | 700 | (?l . ,imap-default-user)))))) |
| 708 | ?g imap-shell-host | ||
| 709 | ?p (number-to-string port) | ||
| 710 | ?l imap-default-user))))) | ||
| 711 | (when process | 701 | (when process |
| 712 | (while (and (memq (process-status process) '(open run)) | 702 | (while (and (memq (process-status process) '(open run)) |
| 713 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | 703 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug |
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1d5cf382a84..1c371f59870 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el | |||
| @@ -170,8 +170,8 @@ a greeting from the server. | |||
| 170 | :nowait, if non-nil, says the connection should be made | 170 | :nowait, if non-nil, says the connection should be made |
| 171 | asynchronously, if possible. | 171 | asynchronously, if possible. |
| 172 | 172 | ||
| 173 | :shell-command is a format-spec string that can be used if :type | 173 | :shell-command is a `format-spec' string that can be used if |
| 174 | is `shell'. It has two specs, %s for host and %p for port | 174 | :type is `shell'. It has two specs, %s for host and %p for port |
| 175 | number. Example: \"ssh gateway nc %s %p\". | 175 | number. Example: \"ssh gateway nc %s %p\". |
| 176 | 176 | ||
| 177 | :tls-parameters is a list that should be supplied if you're | 177 | :tls-parameters is a list that should be supplied if you're |
| @@ -453,11 +453,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." | |||
| 453 | (network-stream-command stream capability-command eo-capa) | 453 | (network-stream-command stream capability-command eo-capa) |
| 454 | 'tls))))))) | 454 | 'tls))))))) |
| 455 | 455 | ||
| 456 | (declare-function format-spec "format-spec" (format spec)) | ||
| 457 | (declare-function format-spec-make "format-spec" (&rest pairs)) | ||
| 458 | |||
| 459 | (defun network-stream-open-shell (name buffer host service parameters) | 456 | (defun network-stream-open-shell (name buffer host service parameters) |
| 460 | (require 'format-spec) | ||
| 461 | (let* ((capability-command (plist-get parameters :capability-command)) | 457 | (let* ((capability-command (plist-get parameters :capability-command)) |
| 462 | (eoc (plist-get parameters :end-of-command)) | 458 | (eoc (plist-get parameters :end-of-command)) |
| 463 | (start (with-current-buffer buffer (point))) | 459 | (start (with-current-buffer buffer (point))) |
| @@ -467,9 +463,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." | |||
| 467 | shell-command-switch | 463 | shell-command-switch |
| 468 | (format-spec | 464 | (format-spec |
| 469 | (plist-get parameters :shell-command) | 465 | (plist-get parameters :shell-command) |
| 470 | (format-spec-make | 466 | `((?s . ,host) |
| 471 | ?s host | 467 | (?p . ,service))))))) |
| 472 | ?p service)))))) | ||
| 473 | (when coding (if (consp coding) | 468 | (when coding (if (consp coding) |
| 474 | (set-process-coding-system stream | 469 | (set-process-coding-system stream |
| 475 | (car coding) | 470 | (car coding) |
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el index cd091c0108e..d1b215cbfb8 100644 --- a/lisp/obsolete/tls.el +++ b/lisp/obsolete/tls.el | |||
| @@ -47,9 +47,6 @@ | |||
| 47 | 47 | ||
| 48 | (require 'gnutls) | 48 | (require 'gnutls) |
| 49 | 49 | ||
| 50 | (autoload 'format-spec "format-spec") | ||
| 51 | (autoload 'format-spec-make "format-spec") | ||
| 52 | |||
| 53 | (defgroup tls nil | 50 | (defgroup tls nil |
| 54 | "Transport Layer Security (TLS) parameters." | 51 | "Transport Layer Security (TLS) parameters." |
| 55 | :group 'comm) | 52 | :group 'comm) |
| @@ -224,14 +221,11 @@ Fourth arg PORT is an integer specifying a port to connect to." | |||
| 224 | (while (and (not done) (setq cmd (pop cmds))) | 221 | (while (and (not done) (setq cmd (pop cmds))) |
| 225 | (let ((process-connection-type tls-process-connection-type) | 222 | (let ((process-connection-type tls-process-connection-type) |
| 226 | (formatted-cmd | 223 | (formatted-cmd |
| 227 | (format-spec | 224 | (format-spec cmd `((?t . ,(car (gnutls-trustfiles))) |
| 228 | cmd | 225 | (?h . ,host) |
| 229 | (format-spec-make | 226 | (?p . ,(if (integerp port) |
| 230 | ?t (car (gnutls-trustfiles)) | 227 | (number-to-string port) |
| 231 | ?h host | 228 | port)))))) |
| 232 | ?p (if (integerp port) | ||
| 233 | (int-to-string port) | ||
| 234 | port))))) | ||
| 235 | (message "Opening TLS connection with `%s'..." formatted-cmd) | 229 | (message "Opening TLS connection with `%s'..." formatted-cmd) |
| 236 | (setq process (start-process | 230 | (setq process (start-process |
| 237 | name buffer shell-file-name shell-command-switch | 231 | name buffer shell-file-name shell-command-switch |
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 1b302e34a73..e3d5759579a 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el | |||
| @@ -2295,9 +2295,6 @@ FILE is typically the output DVI or PDF file." | |||
| 2295 | (setq uptodate nil))))) | 2295 | (setq uptodate nil))))) |
| 2296 | uptodate))) | 2296 | uptodate))) |
| 2297 | 2297 | ||
| 2298 | |||
| 2299 | (autoload 'format-spec "format-spec") | ||
| 2300 | |||
| 2301 | (defvar tex-executable-cache nil) | 2298 | (defvar tex-executable-cache nil) |
| 2302 | (defun tex-executable-exists-p (name) | 2299 | (defun tex-executable-exists-p (name) |
| 2303 | "Like `executable-find' but with a cache." | 2300 | "Like `executable-find' but with a cache." |
diff --git a/test/lisp/battery-tests.el b/test/lisp/battery-tests.el index 052ae49a800..4cb7470d884 100644 --- a/test/lisp/battery-tests.el +++ b/test/lisp/battery-tests.el | |||
| @@ -52,7 +52,7 @@ | |||
| 52 | "Test `battery-format'." | 52 | "Test `battery-format'." |
| 53 | (should (equal (battery-format "" ()) "")) | 53 | (should (equal (battery-format "" ()) "")) |
| 54 | (should (equal (battery-format "" '((?b . "-"))) "")) | 54 | (should (equal (battery-format "" '((?b . "-"))) "")) |
| 55 | (should (equal (battery-format "%a%b%p%%" '((?b . "-") (?p . "99"))) | 55 | (should (equal (battery-format "%2a%-3b%.1p%%" '((?b . "-") (?p . "99"))) |
| 56 | "-99%"))) | 56 | "- 9%"))) |
| 57 | 57 | ||
| 58 | ;;; battery-tests.el ends here | 58 | ;;; battery-tests.el ends here |
diff --git a/test/lisp/format-spec-tests.el b/test/lisp/format-spec-tests.el index 23ee88c5269..11882217afb 100644 --- a/test/lisp/format-spec-tests.el +++ b/test/lisp/format-spec-tests.el | |||
| @@ -22,22 +22,145 @@ | |||
| 22 | (require 'ert) | 22 | (require 'ert) |
| 23 | (require 'format-spec) | 23 | (require 'format-spec) |
| 24 | 24 | ||
| 25 | (ert-deftest test-format-spec () | 25 | (ert-deftest format-spec-make () |
| 26 | "Test `format-spec-make'." | ||
| 27 | (should-not (format-spec-make)) | ||
| 28 | (should-error (format-spec-make ?b)) | ||
| 29 | (should (equal (format-spec-make ?b "b") '((?b . "b")))) | ||
| 30 | (should-error (format-spec-make ?b "b" ?a)) | ||
| 31 | (should (equal (format-spec-make ?b "b" ?a 'a) | ||
| 32 | '((?b . "b") | ||
| 33 | (?a . a))))) | ||
| 34 | |||
| 35 | (ert-deftest format-spec-parse-flags () | ||
| 36 | "Test `format-spec--parse-flags'." | ||
| 37 | (should-not (format-spec--parse-flags nil)) | ||
| 38 | (should-not (format-spec--parse-flags "")) | ||
| 39 | (should (equal (format-spec--parse-flags "-") '(:pad-right))) | ||
| 40 | (should (equal (format-spec--parse-flags " 0") '(:pad-zero))) | ||
| 41 | (should (equal (format-spec--parse-flags " -x0y< >^_z ") | ||
| 42 | '(:pad-right :pad-zero :chop-left :chop-right | ||
| 43 | :upcase :downcase)))) | ||
| 44 | |||
| 45 | (ert-deftest format-spec-do-flags () | ||
| 46 | "Test `format-spec--do-flags'." | ||
| 47 | (should (equal (format-spec--do-flags "" () nil nil) "")) | ||
| 48 | (dolist (flag '(:pad-zero :pad-right :upcase :downcase | ||
| 49 | :chop-left :chop-right)) | ||
| 50 | (should (equal (format-spec--do-flags "" (list flag) nil nil) ""))) | ||
| 51 | (should (equal (format-spec--do-flags "FOOBAR" '(:downcase :chop-right) 5 2) | ||
| 52 | " fo")) | ||
| 53 | (should (equal (format-spec--do-flags | ||
| 54 | "foobar" '(:pad-zero :pad-right :upcase :chop-left) 5 2) | ||
| 55 | "AR000"))) | ||
| 56 | |||
| 57 | (ert-deftest format-spec-do-flags-truncate () | ||
| 58 | "Test `format-spec--do-flags' truncation." | ||
| 59 | (let (flags) | ||
| 60 | (should (equal (format-spec--do-flags "" flags nil 0) "")) | ||
| 61 | (should (equal (format-spec--do-flags "" flags nil 1) "")) | ||
| 62 | (should (equal (format-spec--do-flags "a" flags nil 0) "")) | ||
| 63 | (should (equal (format-spec--do-flags "a" flags nil 1) "a")) | ||
| 64 | (should (equal (format-spec--do-flags "a" flags nil 2) "a")) | ||
| 65 | (should (equal (format-spec--do-flags "asd" flags nil 0) "")) | ||
| 66 | (should (equal (format-spec--do-flags "asd" flags nil 1) "a"))) | ||
| 67 | (let ((flags '(:chop-left))) | ||
| 68 | (should (equal (format-spec--do-flags "" flags nil 0) "")) | ||
| 69 | (should (equal (format-spec--do-flags "" flags nil 1) "")) | ||
| 70 | (should (equal (format-spec--do-flags "a" flags nil 0) "")) | ||
| 71 | (should (equal (format-spec--do-flags "a" flags nil 1) "a")) | ||
| 72 | (should (equal (format-spec--do-flags "a" flags nil 2) "a")) | ||
| 73 | (should (equal (format-spec--do-flags "asd" flags nil 0) "")) | ||
| 74 | (should (equal (format-spec--do-flags "asd" flags nil 1) "d")))) | ||
| 75 | |||
| 76 | (ert-deftest format-spec-do-flags-pad () | ||
| 77 | "Test `format-spec--do-flags' padding." | ||
| 78 | (let (flags) | ||
| 79 | (should (equal (format-spec--do-flags "" flags 0 nil) "")) | ||
| 80 | (should (equal (format-spec--do-flags "" flags 1 nil) " ")) | ||
| 81 | (should (equal (format-spec--do-flags "a" flags 0 nil) "a")) | ||
| 82 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 83 | (should (equal (format-spec--do-flags "a" flags 2 nil) " a"))) | ||
| 84 | (let ((flags '(:pad-zero))) | ||
| 85 | (should (equal (format-spec--do-flags "" flags 0 nil) "")) | ||
| 86 | (should (equal (format-spec--do-flags "" flags 1 nil) "0")) | ||
| 87 | (should (equal (format-spec--do-flags "a" flags 0 nil) "a")) | ||
| 88 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 89 | (should (equal (format-spec--do-flags "a" flags 2 nil) "0a"))) | ||
| 90 | (let ((flags '(:pad-right))) | ||
| 91 | (should (equal (format-spec--do-flags "" flags 0 nil) "")) | ||
| 92 | (should (equal (format-spec--do-flags "" flags 1 nil) " ")) | ||
| 93 | (should (equal (format-spec--do-flags "a" flags 0 nil) "a")) | ||
| 94 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 95 | (should (equal (format-spec--do-flags "a" flags 2 nil) "a "))) | ||
| 96 | (let ((flags '(:pad-right :pad-zero))) | ||
| 97 | (should (equal (format-spec--do-flags "" flags 0 nil) "")) | ||
| 98 | (should (equal (format-spec--do-flags "" flags 1 nil) "0")) | ||
| 99 | (should (equal (format-spec--do-flags "a" flags 0 nil) "a")) | ||
| 100 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 101 | (should (equal (format-spec--do-flags "a" flags 2 nil) "a0")))) | ||
| 102 | |||
| 103 | (ert-deftest format-spec-do-flags-chop () | ||
| 104 | "Test `format-spec--do-flags' chopping." | ||
| 105 | (let ((flags '(:chop-left))) | ||
| 106 | (should (equal (format-spec--do-flags "a" flags 0 nil) "")) | ||
| 107 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 108 | (should (equal (format-spec--do-flags "asd" flags 0 nil) "")) | ||
| 109 | (should (equal (format-spec--do-flags "asd" flags 1 nil) "d"))) | ||
| 110 | (let ((flags '(:chop-right))) | ||
| 111 | (should (equal (format-spec--do-flags "a" flags 0 nil) "")) | ||
| 112 | (should (equal (format-spec--do-flags "a" flags 1 nil) "a")) | ||
| 113 | (should (equal (format-spec--do-flags "asd" flags 0 nil) "")) | ||
| 114 | (should (equal (format-spec--do-flags "asd" flags 1 nil) "a")))) | ||
| 115 | |||
| 116 | (ert-deftest format-spec-do-flags-case () | ||
| 117 | "Test `format-spec--do-flags' case fiddling." | ||
| 118 | (dolist (flag '(:pad-zero :pad-right :chop-left :chop-right)) | ||
| 119 | (let ((flags (list flag))) | ||
| 120 | (should (equal (format-spec--do-flags "a" flags nil nil) "a")) | ||
| 121 | (should (equal (format-spec--do-flags "A" flags nil nil) "A"))) | ||
| 122 | (let ((flags (list flag :downcase))) | ||
| 123 | (should (equal (format-spec--do-flags "a" flags nil nil) "a")) | ||
| 124 | (should (equal (format-spec--do-flags "A" flags nil nil) "a"))) | ||
| 125 | (let ((flags (list flag :upcase))) | ||
| 126 | (should (equal (format-spec--do-flags "a" flags nil nil) "A")) | ||
| 127 | (should (equal (format-spec--do-flags "A" flags nil nil) "A"))))) | ||
| 128 | |||
| 129 | (ert-deftest format-spec () | ||
| 130 | (should (equal (format-spec "" ()) "")) | ||
| 131 | (should (equal (format-spec "a" ()) "a")) | ||
| 132 | (should (equal (format-spec "b" '((?b . "bar"))) "b")) | ||
| 133 | (should (equal (format-spec "%%%b%%b%b%%" '((?b . "bar"))) "%bar%bbar%")) | ||
| 26 | (should (equal (format-spec "foo %b zot" `((?b . "bar"))) | 134 | (should (equal (format-spec "foo %b zot" `((?b . "bar"))) |
| 27 | "foo bar zot")) | 135 | "foo bar zot")) |
| 28 | (should (equal (format-spec "foo %-10b zot" '((?b . "bar"))) | 136 | (should (equal (format-spec "foo %-10b zot" '((?b . "bar"))) |
| 29 | "foo bar zot")) | 137 | "foo bar zot")) |
| 30 | (should (equal (format-spec "foo %10b zot" '((?b . "bar"))) | 138 | (should (equal (format-spec "foo %10b zot" '((?b . "bar"))) |
| 31 | "foo bar zot"))) | 139 | "foo bar zot")) |
| 140 | (should (equal-including-properties | ||
| 141 | (format-spec (propertize "a" 'a 'b) '((?a . "foo"))) | ||
| 142 | #("a" 0 1 (a b)))) | ||
| 143 | (let ((fmt (concat (propertize "%a" 'a 'b) | ||
| 144 | (propertize "%%" 'c 'd) | ||
| 145 | "%b" | ||
| 146 | (propertize "%b" 'e 'f)))) | ||
| 147 | (should (equal-including-properties | ||
| 148 | (format-spec fmt '((?b . "asd") (?a . "fgh"))) | ||
| 149 | #("fgh%asdasd" 0 3 (a b) 3 4 (c d) 7 10 (e f)))))) | ||
| 32 | 150 | ||
| 33 | (ert-deftest test-format-unknown () | 151 | (ert-deftest format-spec-unknown () |
| 34 | (should-error (format-spec "foo %b %z zot" '((?b . "bar")))) | 152 | (should-error (format-spec "foo %b %z zot" '((?b . "bar")))) |
| 153 | (should-error (format-spec "foo %b %%%z zot" '((?b . "bar")))) | ||
| 35 | (should (equal (format-spec "foo %b %z zot" '((?b . "bar")) t) | 154 | (should (equal (format-spec "foo %b %z zot" '((?b . "bar")) t) |
| 36 | "foo bar %z zot")) | 155 | "foo bar %z zot")) |
| 37 | (should (equal (format-spec "foo %b %z %% zot" '((?b . "bar")) t) | 156 | (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) t) |
| 38 | "foo bar %z %% zot"))) | 157 | "foo bar %%%4z %%4 zot")) |
| 158 | (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) 'ignore) | ||
| 159 | "foo bar %%4z %4 zot")) | ||
| 160 | (should (equal (format-spec "foo %4b %%%4z %%4 zot" '((?b . "bar")) 'delete) | ||
| 161 | "foo bar % %4 zot"))) | ||
| 39 | 162 | ||
| 40 | (ert-deftest test-format-modifiers () | 163 | (ert-deftest format-spec-flags () |
| 41 | (should (equal (format-spec "foo %10b zot" '((?b . "bar"))) | 164 | (should (equal (format-spec "foo %10b zot" '((?b . "bar"))) |
| 42 | "foo bar zot")) | 165 | "foo bar zot")) |
| 43 | (should (equal (format-spec "foo % 10b zot" '((?b . "bar"))) | 166 | (should (equal (format-spec "foo % 10b zot" '((?b . "bar"))) |