Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 5445:6506fcb40fcf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged with trunk.
author Mats Lidell <matsl@xemacs.org>
date Fri, 31 Dec 2010 00:27:29 +0100
parents b9167d522a9a 57a64ab2ae45
children 89331fa1c819
comparison
equal deleted inserted replaced
5444:388762703a21 5445:6506fcb40fcf
761 (nreverse list))) 761 (nreverse list)))
762 762
763 (defun subst-char-in-string (fromchar tochar string &optional inplace) 763 (defun subst-char-in-string (fromchar tochar string &optional inplace)
764 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. 764 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
765 Unless optional argument INPLACE is non-nil, return a new string." 765 Unless optional argument INPLACE is non-nil, return a new string."
766 (let ((i (length string)) 766 (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar
767 (newstr (if inplace string (copy-sequence string)))) 767 (the string string) :test #'eq))
768 (while (> i 0)
769 (setq i (1- i))
770 (if (eq (aref newstr i) fromchar)
771 (aset newstr i tochar)))
772 newstr))
773
774 768
775 ;; XEmacs addition: 769 ;; XEmacs addition:
776 (defun replace-in-string (str regexp newtext &optional literal) 770 (defun replace-in-string (str regexp newtext &optional literal)
777 "Replace all matches in STR for REGEXP with NEWTEXT string, 771 "Replace all matches in STR for REGEXP with NEWTEXT string,
778 and returns the new string. 772 and returns the new string.
957 "Return number of columns STRING occupies when displayed. 951 "Return number of columns STRING occupies when displayed.
958 With international (Mule) support, uses the charset-columns attribute of 952 With international (Mule) support, uses the charset-columns attribute of
959 the characters in STRING, which may not accurately represent the actual 953 the characters in STRING, which may not accurately represent the actual
960 display width when using a window system. With no international support, 954 display width when using a window system. With no international support,
961 simply returns the length of the string." 955 simply returns the length of the string."
962 (if (featurep 'mule) 956 (reduce #'+ (the string string) :initial-value 0 :key #'char-width))
963 (let ((col 0)
964 (len (length string))
965 (i 0))
966 (with-fboundp '(charset-width char-charset)
967 (while (< i len)
968 (setq col (+ col (charset-width (char-charset (aref string i)))))
969 (setq i (1+ i))))
970 col)
971 (length string)))
972 957
973 (defun char-width (character) 958 (defun char-width (character)
974 "Return number of columns a CHARACTER occupies when displayed." 959 "Return number of columns a CHARACTER occupies when displayed."
975 (if (featurep 'mule) 960 (charset-width (char-charset character)))
976 (with-fboundp '(charset-width char-charset)
977 (charset-width (char-charset character)))
978 1))
979 961
980 ;; The following several functions are useful in GNU Emacs 20 because 962 ;; The following several functions are useful in GNU Emacs 20 because
981 ;; of the multibyte "characters" the internal representation of which 963 ;; of the multibyte "characters" the internal representation of which
982 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary. 964 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
983 ;; We provide them for compatibility reasons solely. 965 ;; We provide them for compatibility reasons solely.
999 "Return a vector of characters in STRING." 981 "Return a vector of characters in STRING."
1000 (vconcat string)) 982 (vconcat string))
1001 983
1002 (defun store-substring (string idx obj) 984 (defun store-substring (string idx obj)
1003 "Embed OBJ (string or character) at index IDX of STRING." 985 "Embed OBJ (string or character) at index IDX of STRING."
1004 (let* ((str (cond ((stringp obj) obj) 986 (if (stringp obj)
1005 ((characterp obj) (char-to-string obj)) 987 (replace (the string string) obj :start1 idx)
1006 (t (error 988 (prog1 string (aset string idx obj))))
1007 "Invalid argument (should be string or character): %s"
1008 obj))))
1009 (string-len (length string))
1010 (len (length str))
1011 (i 0))
1012 (while (and (< i len) (< idx string-len))
1013 (aset string idx (aref str i))
1014 (setq idx (1+ idx) i (1+ i)))
1015 string))
1016 989
1017 ;; From FSF 21.1; ELLIPSES is XEmacs addition. 990 ;; From FSF 21.1; ELLIPSES is XEmacs addition.
1018 991
1019 (defun truncate-string-to-width (str end-column &optional start-column padding 992 (defun truncate-string-to-width (str end-column &optional start-column padding
1020 ellipses) 993 ellipses)