[Emacs-diffs] master 866f527: Optional space and unit in `file-size-human-readable' (bug#35756)

[Mattias Engdegård]

branch: master
commit 866f527ddf21050a827fa47e04cfe6163f1c7053
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Optional space and unit in `file-size-human-readable' (bug#35756)
    
    To improve readability of strings produced by
    `file-size-human-readable', add two optional arguments:
    
    - SPACE, to provide a string (typically a space or non-breaking space)
    to put between the number and unit.  For compatibility, the default is
    an empty string.
    
    - UNIT, a string to use as unit.  For compatibility, the default is
    "B" in `iec' mode and the empty string otherwise.
    
    Also fix a glitch with small numbers in `iec' mode which caused a
    stray "i" in the result.
    
    * lisp/files.el (file-size-human-readable):
    Add optional SPACE and UNIT arguments and handle small numbers correctly.
    (files--ask-user-about-large-file, warn-maybe-out-of-memory):
    Call with `iec' and space.
    * test/lisp/files-tests.el (files-test-file-size-human-readable): New test.
    * lisp/url/url-http.el (url-http-simple-after-change-function)
    (url-http-content-length-after-change-function): Call with `iec' and space.
    * etc/NEWS (Lisp Changes): Mention the change.
---
 etc/NEWS                 |  9 +++++++++
 lisp/files.el            | 49 ++++++++++++++++++++++++++++++------------------
 lisp/url/url-http.el     | 11 ++++++-----
 test/lisp/files-tests.el | 23 +++++++++++++++++++++++
 4 files changed, 69 insertions(+), 23 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 02b4292..dca7a72 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2163,6 +2163,15 @@ The functions 'base64-decode-string' and 
'base64-decode-region' now
 accept an optional argument to decode the URL variant of base-64
 encoding.
 
++++
+** The function 'file-size-human-readable' accepts more optional arguments.
+The new third argument is a string put between the number and unit; it
+defaults to the empty string.  The new fourth argument is a string
+representing the unit to use; it defaults to "B" when the second
+argument is 'iec' and the empty string otherwise.  We recomment a
+space or non-breaking space as third argument, and "B" as fourth
+argument, circumstances allowing.
+
 
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 
diff --git a/lisp/files.el b/lisp/files.el
index 5bac49a..a431be8 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1358,7 +1358,7 @@ it means chase no more than that many links and then 
stop."
 
 ;; A handy function to display file sizes in human-readable form.
 ;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
-(defun file-size-human-readable (file-size &optional flavor)
+(defun file-size-human-readable (file-size &optional flavor space unit)
   "Produce a string showing FILE-SIZE in human-readable form.
 
 Optional second argument FLAVOR controls the units and the display format:
@@ -1368,24 +1368,36 @@ Optional second argument FLAVOR controls the units and 
the display format:
  If FLAVOR is `si', each kilobyte is 1000 bytes and the produced suffixes
     are \"k\", \"M\", \"G\", \"T\", etc.
  If FLAVOR is `iec', each kilobyte is 1024 bytes and the produced suffixes
-    are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc."
+    are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc.
+
+Optional third argument SPACE is a string put between the number and unit.
+It defaults to the empty string.  We recommend a single space or
+non-breaking space, unless other constraints prohibit a space in that
+position.
+
+Optional fourth argument UNIT is the unit to use.  It defaults to \"B\"
+when FLAVOR is `iec' and the empty string otherwise.  We recommend \"B\"
+in all cases, since that is the standard symbol for byte."
   (let ((power (if (or (null flavor) (eq flavor 'iec))
                   1024.0
                 1000.0))
-       (post-fixes
-        ;; none, kilo, mega, giga, tera, peta, exa, zetta, yotta
-        (list "" "k" "M" "G" "T" "P" "E" "Z" "Y")))
-    (while (and (>= file-size power) (cdr post-fixes))
+       (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
+    (while (and (>= file-size power) (cdr prefixes))
       (setq file-size (/ file-size power)
-           post-fixes (cdr post-fixes)))
-    (format (if (> (mod file-size 1.0) 0.05)
-               "%.1f%s%s"
-             "%.0f%s%s")
-           file-size
-           (if (and (eq flavor 'iec) (string= (car post-fixes) "k"))
-               "K"
-             (car post-fixes))
-           (if (eq flavor 'iec) "iB" ""))))
+           prefixes (cdr prefixes)))
+    (let* ((prefix (car prefixes))
+           (prefixed-unit (if (eq flavor 'iec)
+                              (concat
+                               (if (string= prefix "k") "K" prefix)
+                               (if (string= prefix "") "" "i")
+                               (or unit "B"))
+                            (concat prefix unit))))
+      (format (if (> (mod file-size 1.0) 0.05)
+                 "%.1f%s%s"
+               "%.0f%s%s")
+             file-size
+              (if (string-empty-p prefixed-unit) "" (or space ""))
+              prefixed-unit))))
 
 (defcustom mounted-file-systems
   (if (memq system-type '(windows-nt cygwin))
@@ -2054,7 +2066,7 @@ think it does, because \"free\" is pretty hard to define 
in practice."
 (defun files--ask-user-about-large-file (size op-type filename offer-raw)
   (let ((prompt (format "File %s is large (%s), really %s?"
                        (file-name-nondirectory filename)
-                       (file-size-human-readable size) op-type)))
+                       (file-size-human-readable size 'iec " ") op-type)))
     (if (not offer-raw)
         (if (y-or-n-p prompt) nil 'abort)
       (let* ((use-dialog (and (display-popup-menus-p)
@@ -2106,9 +2118,10 @@ returns nil or exits non-locally."
 exceeds the %S%% of currently available free memory (%s).
 If that fails, try to open it with `find-file-literally'
 \(but note that some characters might be displayed incorrectly)."
-            (file-size-human-readable size)
+            (file-size-human-readable size 'iec " ")
             out-of-memory-warning-percentage
-            (file-size-human-readable (* total-free-memory 1024)))))))))
+            (file-size-human-readable (* total-free-memory 1024)
+                                       'iec " "))))))))
 
 (defun files--message (format &rest args)
   "Like `message', except sometimes don't print to minibuffer.
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 00803a1..5277601 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1016,7 +1016,8 @@ should be shown to the user."
 (defun url-http-simple-after-change-function (_st _nd _length)
   ;; Function used when we do NOT know how long the document is going to be
   ;; Just _very_ simple 'downloaded %d' type of info.
-  (url-lazy-message "Reading %s..." (file-size-human-readable (buffer-size))))
+  (url-lazy-message "Reading %s..."
+                    (file-size-human-readable (buffer-size) 'iec " ")))
 
 (defun url-http-content-length-after-change-function (_st nd _length)
   "Function used when we DO know how long the document is going to be.
@@ -1029,16 +1030,16 @@ the callback to be triggered."
        (url-percentage (- nd url-http-end-of-headers)
                       url-http-content-length)
        url-http-content-type
-       (file-size-human-readable (- nd url-http-end-of-headers))
-       (file-size-human-readable url-http-content-length)
+       (file-size-human-readable (- nd url-http-end-of-headers) 'iec " ")
+       (file-size-human-readable url-http-content-length 'iec " ")
        (url-percentage (- nd url-http-end-of-headers)
                       url-http-content-length))
     (url-display-percentage
      "Reading... %s of %s (%d%%)"
      (url-percentage (- nd url-http-end-of-headers)
                     url-http-content-length)
-     (file-size-human-readable (- nd url-http-end-of-headers))
-     (file-size-human-readable url-http-content-length)
+     (file-size-human-readable (- nd url-http-end-of-headers) 'iec " ")
+     (file-size-human-readable url-http-content-length 'iec " ")
      (url-percentage (- nd url-http-end-of-headers)
                     url-http-content-length)))
 
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index fe2e958..aa5dbe7 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1259,5 +1259,28 @@ renaming only, rather than modified in-place."
       (ignore-errors (advice-remove #'write-region advice))
       (ignore-errors (delete-file temp-file-name)))))
 
+(ert-deftest files-test-file-size-human-readable ()
+  (should (equal (file-size-human-readable 13) "13"))
+  (should (equal (file-size-human-readable 13 'si) "13"))
+  (should (equal (file-size-human-readable 13 'iec) "13B"))
+  (should (equal (file-size-human-readable 10000) "9.8k"))
+  (should (equal (file-size-human-readable 10000 'si) "10k"))
+  (should (equal (file-size-human-readable 10000 'iec) "9.8KiB"))
+  (should (equal (file-size-human-readable 4294967296 nil) "4G"))
+  (should (equal (file-size-human-readable 4294967296 'si) "4.3G"))
+  (should (equal (file-size-human-readable 4294967296 'iec) "4GiB"))
+  (should (equal (file-size-human-readable 13 nil " ") "13"))
+  (should (equal (file-size-human-readable 13 'si " ") "13"))
+  (should (equal (file-size-human-readable 13 'iec " ") "13 B"))
+  (should (equal (file-size-human-readable 10000 nil " ") "9.8 k"))
+  (should (equal (file-size-human-readable 10000 'si " ") "10 k"))
+  (should (equal (file-size-human-readable 10000 'iec " ") "9.8 KiB"))
+  (should (equal (file-size-human-readable 4294967296 nil " ") "4 G"))
+  (should (equal (file-size-human-readable 4294967296 'si " ") "4.3 G"))
+  (should (equal (file-size-human-readable 4294967296 'iec " ") "4 GiB"))
+  (should (equal (file-size-human-readable 10000 nil " " "bit") "9.8 kbit"))
+  (should (equal (file-size-human-readable 10000 'si " " "bit") "10 kbit"))
+  (should (equal (file-size-human-readable 10000 'iec " " "bit") "9.8 Kibit")))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here