diff options
author | Lars Ingebrigtsen <larsi@gnus.org> | 2020-12-25 05:58:09 +0100 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2020-12-25 05:58:09 +0100 |
commit | af359de91772478587f768300ca61d64a693fedb (patch) | |
tree | 3cc2316011c2ee92658f1b366e8601e2a83f2afb /lisp/emacs-lisp/subr-x.el | |
parent | 269cec13a2fc6ac18b675d0dadd07a3d4e074a72 (diff) | |
download | emacs-af359de91772478587f768300ca61d64a693fedb.tar.gz emacs-af359de91772478587f768300ca61d64a693fedb.tar.bz2 emacs-af359de91772478587f768300ca61d64a693fedb.zip |
Allow `string-limit' to work on encoded strings
* doc/lispref/strings.texi (Creating Strings): Document it.
* lisp/emacs-lisp/subr-x.el (string-limit): Allow limiting on
encoded strings.
Diffstat (limited to 'lisp/emacs-lisp/subr-x.el')
-rw-r--r-- | lisp/emacs-lisp/subr-x.el | 34 |
1 files changed, 29 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index dc5840a0865..9fbb0351af4 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -286,7 +286,7 @@ result will have lines that are longer than LENGTH." (fill-region (point-min) (point-max))) (buffer-string))) -(defun string-limit (string length &optional end) +(defun string-limit (string length &optional end coding-system) "Return (up to) a LENGTH substring of STRING. If STRING is shorter than or equal to LENGTH, the entire string is returned unchanged. @@ -295,15 +295,39 @@ If STRING is longer than LENGTH, return a substring consisting of the first LENGTH characters of STRING. If END is non-nil, return the last LENGTH characters instead. +If CODING-SYSTEM is non-nil, STRING will be encoded before +limiting, and LENGTH is interpreted as the number of bytes to +limit the string to. The result will be a unibyte string that is +shorter than LENGTH, but will not contain \"partial\" characters, +even if CODING-SYSTEM encodes characters with several bytes per +character. + When shortening strings for display purposes, `truncate-string-to-width' is almost always a better alternative than this function." (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) - (cond - ((<= (length string) length) string) - (end (substring string (- (length string) length))) - (t (substring string 0 length)))) + (if coding-system + (let ((result nil) + (result-length 0) + (index (if end (1- (length string)) 0))) + (while (let ((encoded (encode-coding-char + (aref string index) coding-system))) + (and (<= (+ (length encoded) result-length) length) + (progn + (push encoded result) + (cl-incf result-length (length encoded)) + (setq index (if end (1- index) + (1+ index)))) + (if end (> index -1) + (< index (length string))))) + ;; No body. + ) + (apply #'concat (if end result (nreverse result)))) + (cond + ((<= (length string) length) string) + (end (substring string (- (length string) length))) + (t (substring string 0 length))))) (defun string-lines (string &optional omit-nulls) "Split STRING into a list of lines. |