Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 5321:57a64ab2ae45

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implement some basic Lisp functions in terms of Common Lisp builtins. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * simple.el (assoc-ignore-case): Remove a duplicate definition of this function (it's already in subr.el). * iso8859-1.el (char-width): On non-Mule, make this function equivalent to that produced by (constantly 1), but preserve its docstring. * subr.el (subst-char-in-string): Define this in terms of #'substitute, #'nsubstitute. (string-width): Define this using #'reduce and #'char-width. (char-width): Give this a simpler definition, it makes far more sense to check for mule at load time and redefine, as we do in iso8859-1.el. (store-substring): Implement this in terms of #'replace, now #'replace is cheap.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 30 Dec 2010 01:00:40 +0000
parents d27c1ee1943b
children d1b17a33450b 6506fcb40fcf
comparison
equal deleted inserted replaced
5320:31be2a3d121d 5321:57a64ab2ae45
763 (nreverse list))) 763 (nreverse list)))
764 764
765 (defun subst-char-in-string (fromchar tochar string &optional inplace) 765 (defun subst-char-in-string (fromchar tochar string &optional inplace)
766 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. 766 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
767 Unless optional argument INPLACE is non-nil, return a new string." 767 Unless optional argument INPLACE is non-nil, return a new string."
768 (let ((i (length string)) 768 (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar
769 (newstr (if inplace string (copy-sequence string)))) 769 (the string string) :test #'eq))
770 (while (> i 0)
771 (setq i (1- i))
772 (if (eq (aref newstr i) fromchar)
773 (aset newstr i tochar)))
774 newstr))
775
776 770
777 ;; XEmacs addition: 771 ;; XEmacs addition:
778 (defun replace-in-string (str regexp newtext &optional literal) 772 (defun replace-in-string (str regexp newtext &optional literal)
779 "Replace all matches in STR for REGEXP with NEWTEXT string, 773 "Replace all matches in STR for REGEXP with NEWTEXT string,
780 and returns the new string. 774 and returns the new string.
959 "Return number of columns STRING occupies when displayed. 953 "Return number of columns STRING occupies when displayed.
960 With international (Mule) support, uses the charset-columns attribute of 954 With international (Mule) support, uses the charset-columns attribute of
961 the characters in STRING, which may not accurately represent the actual 955 the characters in STRING, which may not accurately represent the actual
962 display width when using a window system. With no international support, 956 display width when using a window system. With no international support,
963 simply returns the length of the string." 957 simply returns the length of the string."
964 (if (featurep 'mule) 958 (reduce #'+ (the string string) :initial-value 0 :key #'char-width))
965 (let ((col 0)
966 (len (length string))
967 (i 0))
968 (with-fboundp '(charset-width char-charset)
969 (while (< i len)
970 (setq col (+ col (charset-width (char-charset (aref string i)))))
971 (setq i (1+ i))))
972 col)
973 (length string)))
974 959
975 (defun char-width (character) 960 (defun char-width (character)
976 "Return number of columns a CHARACTER occupies when displayed." 961 "Return number of columns a CHARACTER occupies when displayed."
977 (if (featurep 'mule) 962 (charset-width (char-charset character)))
978 (with-fboundp '(charset-width char-charset)
979 (charset-width (char-charset character)))
980 1))
981 963
982 ;; The following several functions are useful in GNU Emacs 20 because 964 ;; The following several functions are useful in GNU Emacs 20 because
983 ;; of the multibyte "characters" the internal representation of which 965 ;; of the multibyte "characters" the internal representation of which
984 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary. 966 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
985 ;; We provide them for compatibility reasons solely. 967 ;; We provide them for compatibility reasons solely.
1001 "Return a vector of characters in STRING." 983 "Return a vector of characters in STRING."
1002 (vconcat string)) 984 (vconcat string))
1003 985
1004 (defun store-substring (string idx obj) 986 (defun store-substring (string idx obj)
1005 "Embed OBJ (string or character) at index IDX of STRING." 987 "Embed OBJ (string or character) at index IDX of STRING."
1006 (let* ((str (cond ((stringp obj) obj) 988 (if (stringp obj)
1007 ((characterp obj) (char-to-string obj)) 989 (replace (the string string) obj :start1 idx)
1008 (t (error 990 (prog1 string (aset string idx obj))))
1009 "Invalid argument (should be string or character): %s"
1010 obj))))
1011 (string-len (length string))
1012 (len (length str))
1013 (i 0))
1014 (while (and (< i len) (< idx string-len))
1015 (aset string idx (aref str i))
1016 (setq idx (1+ idx) i (1+ i)))
1017 string))
1018 991
1019 ;; From FSF 21.1; ELLIPSES is XEmacs addition. 992 ;; From FSF 21.1; ELLIPSES is XEmacs addition.
1020 993
1021 (defun truncate-string-to-width (str end-column &optional start-column padding 994 (defun truncate-string-to-width (str end-column &optional start-column padding
1022 ellipses) 995 ellipses)