aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBasil L. Contovounesios2020-05-29 19:56:14 +0100
committerBasil L. Contovounesios2020-06-18 12:46:21 +0100
commit0185d76e7426eb1b58a9b60b0d18e763ddf57dea (patch)
tree68e6f560b1751902e98a241a3bf732b9fd596364
parent97d1f672ac1529ac07a999405f630cb19a1010eb (diff)
downloademacs-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.texi35
-rw-r--r--etc/NEWS17
-rw-r--r--lisp/battery.el18
-rw-r--r--lisp/dired-aux.el15
-rw-r--r--lisp/erc/erc-match.el19
-rw-r--r--lisp/erc/erc.el21
-rw-r--r--lisp/format-spec.el183
-rw-r--r--lisp/gnus/gnus-sieve.el10
-rw-r--r--lisp/gnus/gssapi.el11
-rw-r--r--lisp/gnus/mail-source.el30
-rw-r--r--lisp/gnus/message.el137
-rw-r--r--lisp/image-dired.el1
-rw-r--r--lisp/net/eww.el1
-rw-r--r--lisp/net/imap.el30
-rw-r--r--lisp/net/network-stream.el13
-rw-r--r--lisp/obsolete/tls.el16
-rw-r--r--lisp/textmodes/tex-mode.el3
-rw-r--r--test/lisp/battery-tests.el4
-rw-r--r--test/lisp/format-spec-tests.el135
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
1152similar function to @code{format}, except it operates on format 1152similar function to @code{format}, except it operates on format
1153control strings that use arbitrary specification characters. 1153control 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
1156This function returns a string produced from the format string 1156This 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},
1158which is an alist (@pxref{Association Lists}) of the form 1158which is an alist (@pxref{Association Lists}) of the form
@@ -1185,12 +1185,15 @@ The order of specifications in @var{template} need not correspond to
1185the order of associations in @var{spec-alist}. 1185the order of associations in @var{spec-alist}.
1186@end itemize 1186@end itemize
1187 1187
1188The optional argument @var{only-present} indicates how to handle 1188The optional argument @var{ignore-missing} indicates how to handle
1189specification characters in @var{template} that are not found in 1189specification 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
1191signals an error. Otherwise, those format specifications and any 1191signals an error; if it is @code{ignore}, those format specifications
1192occurrences of @samp{%%} in @var{template} are left verbatim in the 1192are left verbatim in the output, including their text properties, if
1193output, including their text properties, if any. 1193any; if it is @code{delete}, those format specifications are removed
1194from the output; any other non-@code{nil} value is handled like
1195@code{ignore}, but any occurrences of @samp{%%} are also left verbatim
1196in the output.
1194@end defun 1197@end defun
1195 1198
1196The syntax of format specifications accepted by @code{format-spec} is 1199The 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 <
1240This flag causes the substitution to be truncated on the left to the 1243This flag causes the substitution to be truncated on the left to the
1241given width, if specified. 1244given width and precision, if specified.
1242 1245
1243@item > 1246@item >
1244This flag causes the substitution to be truncated on the right to the 1247This 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
1257lower case) is undefined. 1260lower case) is undefined.
1258 1261
1259As is the case with @code{format}, a format specification can include 1262As is the case with @code{format}, a format specification can include
1260a width, which is a decimal number that appears after any flags. If a 1263a width, which is a decimal number that appears after any flags, and a
1261substitution contains fewer characters than its specified width, it is 1264precision, which is a decimal-point @samp{.} followed by a decimal
1262padded on the left: 1265number that appears after any flags and width.
1266
1267If a substitution contains fewer characters than its specified width,
1268it 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
1278If a substitution contains more characters than its specified
1279precision, 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
1272Here is a more complicated example that combines several 1289Here is a more complicated example that combines several
1273aforementioned features: 1290aforementioned features:
1274 1291
diff --git a/etc/NEWS b/etc/NEWS
index d702f758f23..4d730228139 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -461,6 +461,16 @@ In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to
461The old names, which were kept as obsolete aliases of the new names, 461The old names, which were kept as obsolete aliases of the new names,
462have now been removed. 462have now been removed.
463 463
464** Battery
465
466---
467*** A richer syntax can be used to format battery status information.
468The user options 'battery-mode-line-format' and
469'battery-echo-area-format' now support the full formatting syntax of
470the function 'format-spec' documented under '(elisp) Custom Format
471Strings'. The new syntax includes specifiers for padding and
472truncation, 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
578It controls, whether 'process-file' returns a string when a remote 588It controls, whether 'process-file' returns a string when a remote
579process is interrupted by a signal. 589process is interrupted by a signal.
580 590
591+++
592** The behavior of 'format-spec' is now closer to that of 'format'.
593In order for the two functions to behave more consistently,
594'format-spec' now pads and truncates based on string width rather than
595length, and also supports format specifications that include a
596truncating 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
126The 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
161The 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.
1064Within CMD, %i denotes the input file(s), and %o denotes the 1064Within CMD, %i denotes the input file(s), and %o denotes the
1065output file. %i path(s) are relative, while %o is absolute.") 1065output 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.
1073Choose the archiving command based on the archive file-name extension 1071Choose the archiving command based on the archive file-name extension
1074and `dired-compress-files-alist'." 1072and `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.
32FORMAT is a string containing `format'-like specs like \"su - %u %k\". 30FORMAT is a string containing `format'-like specs like \"su - %u %k\".
33SPECIFICATION is an alist mapping format specification characters 31SPECIFICATION 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
42Each %-spec may contain optional flag and width modifiers, as 40Each %-spec may contain optional flag, width, and precision
43follows: 41modifiers, as follows:
44 42
45 %<flags><width>character 43 %<flags><width><precision>character
46 44
47The following flags are allowed: 45The 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
56The width modifier behaves like the corresponding one in `format' 54The width and truncation modifiers behave like the corresponding
57when applied to %s. 55ones in `format' when applied to %s.
58 56
59For example, \"%<010b\" means \"substitute into the output the 57For example, \"%<010b\" means \"substitute into the output the
60value associated with ?b in SPECIFICATION, either padding it with 58value associated with ?b in SPECIFICATION, either padding it with
@@ -64,89 +62,108 @@ characters wide\".
64Any text properties of FORMAT are copied to the result, with any 62Any text properties of FORMAT are copied to the result, with any
65text properties of a %-spec itself copied to its substitution. 63text properties of a %-spec itself copied to its substitution.
66 64
67ONLY-PRESENT indicates how to handle %-spec characters not 65IGNORE-MISSING indicates how to handle %-spec characters not
68present in SPECIFICATION. If it is nil or omitted, emit an 66present in SPECIFICATION. If it is nil or omitted, emit an
69error; otherwise leave those %-specs and any occurrences of 67error; if it is the symbol `ignore', leave those %-specs verbatim
70\"%%\" in FORMAT verbatim in the result, including their text 68in the result, including their text properties, if any; if it is
71properties, if any." 69the symbol `delete', remove those %-specs from the result;
70otherwise do the same as for the symbol `ignore', but also leave
71any 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. 118FLAGS 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)) 120string 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.
148PAIRS is a list where every other element is a character and a value, 166PAIRS is a property list with characters as keys."
149starting 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.
443This is a format-spec string, and you can use %l to say how many 442This is a `format-spec' string, and you can use %l to say how
444lines were removed, and %c to say how many characters were 443many lines were removed, and %c to say how many characters were
445removed." 444removed."
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
171asynchronously, if possible. 171asynchronously, 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
174is `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
175number. Example: \"ssh gateway nc %s %p\". 175number. 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")))