[nongnu] elpa/buttercup 29ade8db75 4/5: Add function buttercup--simple-format

[ELPA Syncer]

branch: elpa/buttercup
commit 29ade8db757a2f385fd700f0ac0345a8ab18fe31
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Add function buttercup--simple-format
    
    buttercup--simple-format is a simplified variant of format-spec, but
    it supports functions as substitutions which was only added in Emacs
    29.
    
    Compared to format-spec it drops the IGNORE-MISSING and SPLIT
    parameters and just ignores any unknown specifications, including % at
    the end of line or not followed by a letter.
    
    The specifications can not have flags, width or precision.  This is a
    simple search and replace.
    
    As a consequence of these simplifications the code is much smaller and
    should actually run faster than format-spec.
    
    It cannot completely replace buttercup-format-spec, as users that
    define their own matcher may use the flags, width and precision.
---
 buttercup.el | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/buttercup.el b/buttercup.el
index 07c3a26d7b..82b3f3fe4f 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -134,6 +134,34 @@ a call to `save-match-data', as `format-spec' modifies 
that."
   (save-match-data
     (format-spec format specification)))
 
+(defun buttercup--simple-format (specification &rest format)
+  "Return a string based on SPECIFICATION and FORMAT.
+A simpler version of `format-spec', which see.
+If more than one FORMAT string is given they will be combined
+before formatting replacements occur.
+
+Does not support flags, width or precision.
+The substitution for a specification character can be a function,
+which is only supported in `format-spec' from Emacs 29.
+Does not have the IGNORE-MISSING and SPLIT parameters."
+  (save-match-data
+    (with-temp-buffer
+      (apply #'insert format)
+      (goto-char 1)
+      (while (search-forward "%" nil t)
+        (cond
+         ((= (following-char) ?%)
+          (delete-char 1))
+         ((looking-at-p (rx alpha))
+          (let* ((char (following-char))
+                 (begin (point))
+                 (replacement (cdr (assq char specification)))
+                 (text (if (functionp replacement) (funcall replacement) 
replacement)))
+            (insert-and-inherit text)
+            (delete-char 1)
+            (delete-region (1- begin) begin)))))
+      (buffer-string))))
+
 ;;;;;;;;;;
 ;;; expect