summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/subr-x.el
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2020-12-25 05:58:09 +0100
committerLars Ingebrigtsen <larsi@gnus.org>2020-12-25 05:58:09 +0100
commitaf359de91772478587f768300ca61d64a693fedb (patch)
tree3cc2316011c2ee92658f1b366e8601e2a83f2afb /lisp/emacs-lisp/subr-x.el
parent269cec13a2fc6ac18b675d0dadd07a3d4e074a72 (diff)
downloademacs-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.el34
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.