;;; mule-util.el --- utility functions for mulitilingual environment (mule)
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Licensed to the Free Software Foundation.
;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+
;; Keywords: mule, multilingual
(error "Invalid type: %s" type)))
;;; val)
)
+
+;;;###autoload
(make-obsolete 'string-to-sequence
- "Use `string-to-list' or `string-to-vector'"
- "21.3")
+ "use `string-to-list' or `string-to-vector'."
+ "21.4")
;;;###autoload
(defsubst string-to-list (string)
string)
;;;###autoload
-(defun truncate-string-to-width (str end-column &optional start-column padding)
+(defun truncate-string-to-width (str end-column
+ &optional start-column padding ellipsis)
"Truncate string STR to end at column END-COLUMN.
-The optional 3rd arg START-COLUMN, if non-nil, specifies
-the starting column; that means to return the characters occupying
-columns START-COLUMN ... END-COLUMN of STR.
-
-The optional 4th arg PADDING, if non-nil, specifies a padding character
-to add at the end of the result if STR doesn't reach column END-COLUMN,
-or if END-COLUMN comes in the middle of a character in STR.
-PADDING is also added at the beginning of the result
-if column START-COLUMN appears in the middle of a character in STR.
+The optional 3rd arg START-COLUMN, if non-nil, specifies the starting
+column; that means to return the characters occupying columns
+START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN
+are specified in terms of character display width in the current
+buffer; see also `char-width'.
+
+The optional 4th arg PADDING, if non-nil, specifies a padding
+character (which should have a display width of 1) to add at the end
+of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN
+comes in the middle of a character in STR. PADDING is also added at
+the beginning of the result if column START-COLUMN appears in the
+middle of a character in STR.
If PADDING is nil, no padding is added in these cases, so
-the resulting string may be narrower than END-COLUMN."
+the resulting string may be narrower than END-COLUMN.
+
+If ELLIPSIS is non-nil, it should be a string which will replace the
+end of STR (including any padding) if it extends beyond END-COLUMN,
+unless the display width of STR is equal to or less than the display
+width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
+defaults to \"...\"."
(or start-column
(setq start-column 0))
- (let ((len (length str))
+ (when (and ellipsis (not (stringp ellipsis)))
+ (setq ellipsis "..."))
+ (let ((str-len (length str))
+ (str-width (string-width str))
+ (ellipsis-len (if ellipsis (length ellipsis) 0))
+ (ellipsis-width (if ellipsis (string-width ellipsis) 0))
(idx 0)
(column 0)
(head-padding "") (tail-padding "")
(setq ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
- (args-out-of-range (setq idx len)))
+ (args-out-of-range (setq idx str-len)))
(if (< column start-column)
(if padding (make-string end-column padding) "")
- (if (and padding (> column start-column))
- (setq head-padding (make-string (- column start-column) padding)))
+ (when (and padding (> column start-column))
+ (setq head-padding (make-string (- column start-column) padding)))
(setq from-idx idx)
- (if (< end-column column)
- (setq idx from-idx)
+ (when (>= end-column column)
+ (if (and (< end-column str-width)
+ (> str-width ellipsis-width))
+ (setq end-column (- end-column ellipsis-width))
+ (setq ellipsis ""))
(condition-case nil
(while (< column end-column)
(setq last-column column
ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
- (args-out-of-range (setq idx len)))
- (if (> column end-column)
- (setq column last-column idx last-idx))
- (if (and padding (< column end-column))
- (setq tail-padding (make-string (- end-column column) padding))))
- (setq str (substring str from-idx idx))
- (if padding
- (concat head-padding str tail-padding)
- str))))
+ (args-out-of-range (setq idx str-len)))
+ (when (> column end-column)
+ (setq column last-column
+ idx last-idx))
+ (when (and padding (< column end-column))
+ (setq tail-padding (make-string (- end-column column) padding))))
+ (concat head-padding (substring str from-idx idx)
+ tail-padding ellipsis))))
+
+;;; Test suite for truncate-string-to-width
+;; (dolist (test '((("" 0) . "")
+;; (("x" 1) . "x")
+;; (("xy" 1) . "x")
+;; (("xy" 2 1) . "y")
+;; (("xy" 0) . "")
+;; (("xy" 3) . "xy")
+;; (("\e$AVP\e(B" 0) . "")
+;; (("\e$AVP\e(B" 1) . "")
+;; (("\e$AVP\e(B" 2) . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ? ) . " ")
+;; (("\e$AVPND\e(B" 3 1 ? ) . " ")
+;; (("x\e$AVP\e(Bx" 2) . "x")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 4 1) . "\e$AVP\e(Bx")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 8 1 ? ) . "or\e$(CGQ\e(Be\e$(C1[\e(B")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 7 2 ? ) . "r\e$(CGQ\e(Be ")
+;; (("" 0 nil nil "...") . "")
+;; (("x" 3 nil nil "...") . "x")
+;; (("\e$AVP\e(B" 3 nil nil "...") . "\e$AVP\e(B")
+;; (("foo" 3 nil nil "...") . "foo")
+;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure?
+;; (("foobar" 6 0 nil "...") . "foobar")
+;; (("foobarbaz" 6 nil nil "...") . "foo...")
+;; (("foobarbaz" 7 2 nil "...") . "ob...")
+;; (("foobarbaz" 9 3 nil "...") . "barbaz")
+;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 15 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo")
+;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(B...")
+;; (("x" 3 nil nil "\e$(0GnM$\e(B") . "x")
+;; (("\e$AVP\e(B" 2 nil nil "\e$(0GnM$\e(B") . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ?x "\e$(0GnM$\e(B") . "x") ;; XEmacs error
+;; (("\e$AVPND\e(B" 3 nil ? "\e$(0GnM$\e(B") . "\e$AVP\e(B ") ;; XEmacs error
+;; (("foobarbaz" 4 nil nil "\e$(0GnM$\e(B") . "\e$(0GnM$\e(B")
+;; (("foobarbaz" 5 nil nil "\e$(0GnM$\e(B") . "f\e$(0GnM$\e(B")
+;; (("foobarbaz" 6 nil nil "\e$(0GnM$\e(B") . "fo\e$(0GnM$\e(B")
+;; (("foobarbaz" 8 3 nil "\e$(0GnM$\e(B") . "b\e$(0GnM$\e(B")
+;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 4 ?x "\e$BF|K\8l\e(B") . "xe\e$B$KF|K\8l\e(B")
+;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 13 4 ?x "\e$BF|K\8l\e(B") . "xex\e$BF|K\8l\e(B")
+;; ))
+;; (let (ret)
+;; (condition-case e
+;; (setq ret (apply #'truncate-string-to-width (car test)))
+;; (error (setq ret e)))
+;; (unless (equal ret (cdr test))
+;; (error "%s: expected %s, got %s"
+;; (prin1-to-string (cons 'truncate-string-to-width (car test)))
+;; (prin1-to-string (cdr test))
+;; (if (consp ret)
+;; (format "error: %s: %s" (car ret)
+;; (prin1-to-string (cdr ret)))
+;; (prin1-to-string ret))))))
;;; For backward compatibility ...
;;;###autoload
(defalias 'truncate-string 'truncate-string-to-width)
+
+;;;###autoload
(make-obsolete 'truncate-string 'truncate-string-to-width "20.1")
\f
;;; Nested alist handler. Nested alist is alist whose elements are
Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is
any Lisp object, and BRANCHES is a list of cons cells of the form
-(KEY-ELEMENT . NESTED-ALIST).
+\(KEY-ELEMENT . NESTED-ALIST).
You can use a nested alist to store any Lisp object (ENTRY) for a key
sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ
\f
;; Coding system related functions.
-;;;###autoload
-(defun coding-system-eol-type-mnemonic (coding-system)
- "Return the string indicating end-of-line format of CODING-SYSTEM."
- (let* ((eol-type (coding-system-eol-type coding-system))
- (val (cond ((vectorp eol-type) eol-mnemonic-undecided)
- ((eq eol-type 0) eol-mnemonic-unix)
- ((eq eol-type 1) eol-mnemonic-dos)
- ((eq eol-type 2) eol-mnemonic-mac)
- (t "-"))))
- (if (stringp val)
- val
- (char-to-string val))))
-
;;;###autoload
(defun coding-system-post-read-conversion (coding-system)
"Return the value of CODING-SYSTEM's `post-read-conversion' property."
;;;###autoload
(defun coding-system-translation-table-for-decode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-decode' property."
+ "Return the value of CODING-SYSTEM's `decode-translation-table' property."
(coding-system-get coding-system :decode-translation-table))
;;;###autoload
(defun coding-system-translation-table-for-encode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-encode' property."
+ "Return the value of CODING-SYSTEM's `encode-translation-table' property."
(coding-system-get coding-system :encode-translation-table))
;;;###autoload
(or (eq eol-type-1 eol-type-2)
(and (vectorp eol-type-1) (vectorp eol-type-2)))))))
+;;;###autoload
+(defmacro with-coding-priority (coding-systems &rest body)
+ "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
+CODING-SYSTEMS is a list of coding systems. See
+`set-coding-priority'. This affects the implicit sorting of lists of
+coding sysems returned by operations such as `find-coding-systems-region'."
+ (let ((current (make-symbol "current")))
+ `(let ((,current (coding-system-priority-list)))
+ (apply #'set-coding-system-priority ,coding-systems)
+ (unwind-protect
+ (progn ,@body)
+ (apply #'set-coding-system-priority ,current)))))
+(put 'with-coding-priority 'lisp-indent-function 1)
+(put 'with-coding-priority 'edebug-form-spec t)
+
;;;###autoload
(defmacro detect-coding-with-priority (from to priority-list)
"Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
(with-coding-priority coding-priority
(detect-coding-region from to)))))
-;;;###autoload
-(defmacro with-coding-priority (coding-systems &rest body)
- "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
-CODING-SYSTEMS is a list of coding systems. See
-`set-coding-priority'. This affects the implicit sorting of lists of
-coding sysems returned by operations such as `find-coding-systems-region'."
- (let ((current (make-symbol "current")))
- `(let ((,current (coding-system-priority-list)))
- (apply #'set-coding-system-priority ,coding-systems)
- (unwind-protect
- (progn ,@body)
- (apply #'set-coding-system-priority ,current)))))
-(put 'with-coding-priority 'lisp-indent-function 1)
-(put 'with-coding-priority 'edebug-form-spec t)
\f
(provide 'mule-util)
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+
;;; mule-util.el ends here