diff options
Diffstat (limited to 'lisp/format-spec.el')
| -rw-r--r-- | lisp/format-spec.el | 183 |
1 files changed, 100 insertions, 83 deletions
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 @@ -;;; format-spec.el --- functions for formatting arbitrary formatting strings +;;; format-spec.el --- format arbitrary formatting strings -*- lexical-binding: t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -24,10 +24,8 @@ ;;; Code: -(eval-when-compile - (require 'subr-x)) - -(defun format-spec (format specification &optional only-present) +;;;###autoload +(defun format-spec (format specification &optional ignore-missing) "Return a string based on FORMAT and SPECIFICATION. FORMAT is a string containing `format'-like specs like \"su - %u %k\". SPECIFICATION is an alist mapping format specification characters @@ -39,22 +37,22 @@ For instance: \\=`((?u . ,(user-login-name)) (?l . \"ls\"))) -Each %-spec may contain optional flag and width modifiers, as -follows: +Each %-spec may contain optional flag, width, and precision +modifiers, as follows: - %<flags><width>character + %<flags><width><precision>character The following flags are allowed: * 0: Pad to the width, if given, with zeros instead of spaces. * -: Pad to the width, if given, on the right instead of the left. -* <: Truncate to the width, if given, on the left. -* >: Truncate to the width, if given, on the right. +* <: Truncate to the width and precision, if given, on the left. +* >: Truncate to the width and precision, if given, on the right. * ^: Convert to upper case. * _: Convert to lower case. -The width modifier behaves like the corresponding one in `format' -when applied to %s. +The width and truncation modifiers behave like the corresponding +ones in `format' when applied to %s. For example, \"%<010b\" means \"substitute into the output the value associated with ?b in SPECIFICATION, either padding it with @@ -64,89 +62,108 @@ characters wide\". Any text properties of FORMAT are copied to the result, with any text properties of a %-spec itself copied to its substitution. -ONLY-PRESENT indicates how to handle %-spec characters not +IGNORE-MISSING indicates how to handle %-spec characters not present in SPECIFICATION. If it is nil or omitted, emit an -error; otherwise leave those %-specs and any occurrences of -\"%%\" in FORMAT verbatim in the result, including their text -properties, if any." +error; if it is the symbol `ignore', leave those %-specs verbatim +in the result, including their text properties, if any; if it is +the symbol `delete', remove those %-specs from the result; +otherwise do the same as for the symbol `ignore', but also leave +any occurrences of \"%%\" in FORMAT verbatim in the result." (with-temp-buffer (insert format) (goto-char (point-min)) (while (search-forward "%" nil t) (cond - ;; Quoted percent sign. - ((eq (char-after) ?%) - (unless only-present - (delete-char 1))) - ;; Valid format spec. - ((looking-at "\\([-0 _^<>]*\\)\\([0-9.]*\\)\\([a-zA-Z]\\)") - (let* ((modifiers (match-string 1)) - (num (match-string 2)) - (spec (string-to-char (match-string 3))) - (val (assq spec specification))) - (if (not val) - (unless only-present - (error "Invalid format character: `%%%c'" spec)) - (setq val (cdr val) - modifiers (format-spec--parse-modifiers modifiers)) - ;; Pad result to desired length. - (let ((text (format "%s" val))) - (when num - (setq num (string-to-number num)) - (setq text (format-spec--pad text num modifiers)) - (when (> (length text) num) - (cond - ((memq :chop-left modifiers) - (setq text (substring text (- (length text) num)))) - ((memq :chop-right modifiers) - (setq text (substring text 0 num)))))) - (when (memq :uppercase modifiers) - (setq text (upcase text))) - (when (memq :lowercase modifiers) - (setq text (downcase text))) - ;; Insert first, to preserve text properties. - (insert-and-inherit text) - ;; Delete the specifier body. - (delete-region (+ (match-beginning 0) (length text)) - (+ (match-end 0) (length text))) - ;; Delete the percent sign. - (delete-region (1- (match-beginning 0)) (match-beginning 0)))))) - ;; Signal an error on bogus format strings. - (t - (unless only-present - (error "Invalid format string"))))) + ;; Quoted percent sign. + ((= (following-char) ?%) + (when (memq ignore-missing '(nil ignore delete)) + (delete-char 1))) + ;; Valid format spec. + ((looking-at (rx (? (group (+ (in " 0<>^_-")))) + (? (group (+ digit))) + (? (group ?. (+ digit))) + (group alpha))) + (let* ((beg (point)) + (end (match-end 0)) + (flags (match-string 1)) + (width (match-string 2)) + (trunc (match-string 3)) + (char (string-to-char (match-string 4))) + (text (assq char specification))) + (cond (text + ;; Handle flags. + (setq text (format-spec--do-flags + (format "%s" (cdr text)) + (format-spec--parse-flags flags) + (and width (string-to-number width)) + (and trunc (car (read-from-string trunc 1))))) + ;; Insert first, to preserve text properties. + (insert-and-inherit text) + ;; Delete the specifier body. + (delete-region (point) (+ end (length text))) + ;; Delete the percent sign. + (delete-region (1- beg) beg)) + ((eq ignore-missing 'delete) + ;; Delete the whole format spec. + (delete-region (1- beg) end)) + ((not ignore-missing) + (error "Invalid format character: `%%%c'" char))))) + ;; Signal an error on bogus format strings. + ((not ignore-missing) + (error "Invalid format string")))) (buffer-string))) -(defun format-spec--pad (text total-length modifiers) - (if (> (length text) total-length) - ;; The text is longer than the specified length; do nothing. - text - (let ((padding (make-string (- total-length (length text)) - (if (memq :zero-pad modifiers) - ?0 - ?\s)))) - (if (memq :right-pad modifiers) - (concat text padding) - (concat padding text))))) - -(defun format-spec--parse-modifiers (modifiers) +(defun format-spec--do-flags (str flags width trunc) + "Return STR formatted according to FLAGS, WIDTH, and TRUNC. +FLAGS is a list of keywords as returned by +`format-spec--parse-flags'. WIDTH and TRUNC are either nil or +string widths corresponding to `format-spec' modifiers." + (let (diff str-width) + ;; Truncate original string first, like `format' does. + (when trunc + (setq str-width (string-width str)) + (when (> (setq diff (- str-width trunc)) 0) + (setq str (if (memq :chop-left flags) + (truncate-string-to-width str str-width diff) + (format (format "%%.%ds" trunc) str)) + ;; We know the new width so save it for later. + str-width trunc))) + ;; Pad or chop to width. + (when width + (setq str-width (or str-width (string-width str)) + diff (- width str-width)) + (cond ((zerop diff)) + ((> diff 0) + (let ((pad (make-string diff (if (memq :pad-zero flags) ?0 ?\s)))) + (setq str (if (memq :pad-right flags) + (concat str pad) + (concat pad str))))) + ((memq :chop-left flags) + (setq str (truncate-string-to-width str str-width (- diff)))) + ((memq :chop-right flags) + (setq str (format (format "%%.%ds" width) str)))))) + ;; Fiddle case. + (cond ((memq :upcase flags) + (upcase str)) + ((memq :downcase flags) + (downcase str)) + (str))) + +(defun format-spec--parse-flags (flags) + "Convert sequence of FLAGS to list of human-readable keywords." (mapcan (lambda (char) - (when-let ((modifier - (pcase char - (?0 :zero-pad) - (?\s :space-pad) - (?^ :uppercase) - (?_ :lowercase) - (?- :right-pad) - (?< :chop-left) - (?> :chop-right)))) - (list modifier))) - modifiers)) + (pcase char + (?0 (list :pad-zero)) + (?- (list :pad-right)) + (?< (list :chop-left)) + (?> (list :chop-right)) + (?^ (list :upcase)) + (?_ (list :downcase)))) + flags)) (defun format-spec-make (&rest pairs) "Return an alist suitable for use in `format-spec' based on PAIRS. -PAIRS is a list where every other element is a character and a value, -starting with a character." +PAIRS is a property list with characters as keys." (let (alist) (while pairs (unless (cdr pairs) |