Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-util.el @ 187:b405438285a2 r20-3b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b20
author cvs
date Mon, 13 Aug 2007 09:56:28 +0200
parents 85ec50267440
children
comparison
equal deleted inserted replaced
186:24ac94803b48 187:b405438285a2
1 ;;; mule-util.el --- Utility functions for mulitilingual environment (mule) 1 ;;; mule-util.el --- Utility functions for multilingual environment (mule)
2 2
3 ;; Copyright (C) 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
5 ;; Copyright (C) 1997 MORIOKA Tomohiko 5 ;; Copyright (C) 1997 MORIOKA Tomohiko
6 6
26 ;;; Code: 26 ;;; Code:
27 27
28 ;;; String manipulations while paying attention to multibyte 28 ;;; String manipulations while paying attention to multibyte
29 ;;; characters. 29 ;;; characters.
30 30
31 ;; [Was defsubst] 31 ;; That code is pointless in XEmacs/Mule, since our multibyte
32 ;;;###autoload 32 ;; representation doesn't leak to Lisp.
33 (defun string-to-sequence (string type) 33
34 "Convert STRING to a sequence of TYPE which contains characters in STRING. 34 ;; string-to-sequence, string-to-list, string-to-vector, store-substring,
35 TYPE should be `list' or `vector'. 35 ;; truncate-string-to-width
36 Multibyte characters are concerned." 36
37 (map type (function identity) string))
38
39 ;; [Was defsubst]
40 ;;;###autoload
41 (defun string-to-list (string)
42 "Return a list of characters in STRING."
43 (mapcar (function identity) string))
44
45 ;; [Was defsubst]
46 ;;;###autoload
47 (defun string-to-vector (string)
48 "Return a vector of characters in STRING."
49 (string-to-sequence string 'vector))
50
51 ;;;###autoload
52 (defun store-substring (string idx obj)
53 "Embed OBJ (string or character) at index IDX of STRING."
54 (let* ((str (cond ((stringp obj) obj)
55 ((characterp obj) (char-to-string obj))
56 (t (error
57 "Invalid argument (should be string or character): %s"
58 obj))))
59 (string-len (length string))
60 (len (length str))
61 (i 0))
62 (while (and (< i len) (< idx string-len))
63 (aset string idx (aref str i))
64 (setq idx (1+ idx) i (1+ i)))
65 string))
66
67 ;;;###autoload
68 (defun truncate-string-to-width (str width &optional start-column padding)
69 "Truncate string STR to fit in WIDTH columns.
70 Optional 1st arg START-COLUMN if non-nil specifies the starting column.
71 Optional 2nd arg PADDING if non-nil is a padding character to be padded at
72 the head and tail of the resulting string to fit in WIDTH if necessary.
73 If PADDING is nil, the resulting string may be narrower than WIDTH."
74 (or start-column
75 (setq start-column 0))
76 (let ((len (length str))
77 (idx 0)
78 (column 0)
79 (head-padding "") (tail-padding "")
80 ch last-column last-idx from-idx)
81 (condition-case nil
82 (while (< column start-column)
83 (setq ch (sref str idx)
84 column (+ column (char-width ch))
85 idx (+ idx (char-bytes ch))))
86 (args-out-of-range (setq idx len)))
87 (if (< column start-column)
88 (if padding (make-string width padding) "")
89 (if (and padding (> column start-column))
90 (setq head-padding (make-string (- column start-column) ?\ )))
91 (setq from-idx idx)
92 (condition-case nil
93 (while (< column width)
94 (setq last-column column
95 last-idx idx
96 ch (sref str idx)
97 column (+ column (char-width ch))
98 idx (+ idx (char-bytes ch))))
99 (args-out-of-range (setq idx len)))
100 (if (> column width)
101 (setq column last-column idx last-idx))
102 (if (and padding (< column width))
103 (setq tail-padding (make-string (- width column) padding)))
104 (setq str (substring str from-idx idx))
105 (if padding
106 (concat head-padding str tail-padding)
107 str))))
108
109 ;;; For backward compatiblity ...
110 ;;;###autoload
111 (defalias 'truncate-string 'truncate-string-to-width)
112 (make-obsolete 'truncate-string 'truncate-string-to-width)
113 37
114 ;;; Nested alist handler. Nested alist is alist whose elements are 38 ;;; Nested alist handler. Nested alist is alist whose elements are
115 ;;; also nested alist. 39 ;;; also nested alist.
116 40
117 ;; [Was defsubst] 41 ;; [Was defsubst]