diff lisp/mule/mule-misc.el @ 82:6a378aca36af r20-0b91

Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 131b0175ea99
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/mule/mule-misc.el	Mon Aug 13 09:06:45 2007 +0200
+++ b/lisp/mule/mule-misc.el	Mon Aug 13 09:07:36 2007 +0200
@@ -53,16 +53,7 @@
 (defun string-to-char-list (str)
   (mapcar 'identity str))
 
-;;; Slower, albeit more elegant, implementation??
-;; (defun string-columns (string)
-;;  "Return number of columns STRING occupies when displayed.
-;; Uses the charset-columns attribute of the characters in STRING,
-;; which may not accurately represent the actual display width in a
-;; window system."
-;;  (loop for c across string
-;;     sum (charset-columns (char-charset c))))
-
-(defun string-columns (string)
+(defun string-width (string)
   "Return number of columns STRING occupies when displayed.
 Uses the charset-columns attribute of the characters in STRING,
 which may not accurately represent the actual display width when
@@ -75,7 +66,8 @@
       (setq i (1+ i)))
     col))
 
-(defalias 'string-width 'string-columns)
+(defalias 'string-columns 'string-width)
+(make-obsolete 'string-columns 'string-width)
 
 (defun delete-text-in-column (from to)
   "Delete the text between column FROM and TO (exclusive) of the current line.
@@ -154,22 +146,76 @@
 	   (null (car buffer-undo-list)) )
       (setq buffer-undo-list (cdr buffer-undo-list)) ))
 
+
 ;;; Common API emulation functions for GNU Emacs-merged Mule.
 ;;; As suggested by MORIOKA Tomohiko
-(defun truncate-string (str width &optional start-column)
-  "Truncate STR to fit in WIDTH columns.
-Optional non-nil arg START-COLUMN specifies the starting column."
-  (substring str (or start-column 0) width))
+
+;; Following definition were imported from Emacs/mule-delta.
+
+(defun truncate-string-to-width (str width &optional start-column padding)
+  "Truncate string STR to fit in WIDTH columns.
+Optional 1st arg START-COLUMN if non-nil specifies the starting column.
+Optional 2nd arg PADDING if non-nil, space characters are padded at
+the head and tail of the resulting string to fit in WIDTH if necessary.
+If PADDING is nil, the resulting string may be narrower than WIDTH."
+  (or start-column
+      (setq start-column 0))
+  (let ((len (length str))
+	(idx 0)
+	(column 0)
+	(head-padding "") (tail-padding "")
+	ch last-column last-idx from-idx)
+    (condition-case nil
+	(while (< column start-column)
+	  (setq ch (sref str idx)
+		column (+ column (char-width ch))
+		idx (+ idx (char-bytes ch))))
+      (args-out-of-range (setq idx len)))
+    (if (< column start-column)
+	(if padding (make-string width ?\ ) "")
+      (if (and padding (> column start-column))
+	  (setq head-padding (make-string (- column start-column) ?\ )))
+      (setq from-idx idx)
+      (condition-case nil
+	  (while (< column width)
+	    (setq last-column column
+		  last-idx idx
+		  ch (sref str idx)
+		  column (+ column (char-width ch))
+		  idx (+ idx (char-bytes ch))))
+	(args-out-of-range (setq idx len)))
+      (if (> column width)
+	  (setq column last-column idx last-idx))
+      (if (and padding (< column width))
+	  (setq tail-padding (make-string (- width column) ?\ )))
+      (setq str (substring str from-idx idx))
+      (if padding
+	  (concat head-padding str tail-padding)
+	str))))
+
+;;; For backward compatiblity ...
+;;;###autoload
+(defalias 'truncate-string 'truncate-string-to-width)
+(make-obsolete 'truncate-string 'truncate-string-to-width)
+
+;; end of imported definition
+
 
 (defalias 'sref 'aref)
 (defalias 'map-char-concat 'mapcar)
-(defun char-bytes (chr) 1)
-(defun char-length (chr) 1)
+(defun char-bytes (character)
+  "Return number of length a CHARACTER occupies in a string or buffer.
+It returns only 1 in XEmacs.  It is for compatibility with MULE 2.3."
+  1)
+(defalias 'char-length 'char-bytes)
 
-(defun char-columns (character)
+(defun char-width (character)
   "Return number of columns a CHARACTER occupies when displayed."
   (charset-columns (char-charset character)))
 
+(defalias 'char-columns 'char-width)
+(make-obsolete 'char-columns 'char-width)
+
 (defalias 'charset-description 'charset-doc-string)
 
 (defalias 'find-charset-string 'charsets-in-string)
@@ -177,44 +223,16 @@
 
 (defun find-non-ascii-charset-string (string)
   "Return a list of charsets in the STRING except ascii.
-For compatibility with Mule"
+It might be available for compatibility with Mule 2.3,
+because its `find-charset-string' ignores ASCII charset."
   (delq 'ascii (charsets-in-string string)))
 
 (defun find-non-ascii-charset-region (start end)
-  "Return a list of charsets except ascii
-in the region between START and END.
-For compatibility with Mule"
+  "Return a list of charsets except ascii in the region between START and END.
+It might be available for compatibility with Mule 2.3,
+because its `find-charset-string' ignores ASCII charset."
   (delq 'ascii (charsets-in-region start end)))
 
-;(defun truncate-string-to-column (str width &optional start-column)
-;  "Truncate STR to fit in WIDTH columns.
-;Optional non-nil arg START-COLUMN specifies the starting column."
-;  (or start-column
-;      (setq start-column 0))
-;  (let ((max-width (string-width str))
-;	(len (length str))
-;	(from 0)
-;	(column 0)
-;	to-prev to ch)
-;    (if (>= width max-width)
-;	(setq width max-width))
-;    (if (>= start-column width)
-;	""
-;      (while (< column start-column)
-;	(setq ch (aref str from)
-;	      column (+ column (char-width ch))
-;	      from (+ from (char-octets ch))))
-;      (if (< width max-width)
-;	  (progn
-;	    (setq to from)
-;	    (while (<= column width)
-;	      (setq ch (aref str to)
-;		    column (+ column (char-width ch))
-;		    to-prev to
-;		    to (+ to (char-octets ch))))
-;	    (setq to to-prev)))
-;      (substring str from to))))
-
 
 ;;; Language environments