Merge from trunk:

[elisp/wanderlust.git] / wl / wl-util.el

diff --git a/wl/wl-util.el b/wl/wl-util.el
index d1f69b3..30f0740 100644 (file)
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -173,12 +173,15 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 ;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
 ;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
 
-(defsubst wl-set-string-width (width string &optional padding)
+(defsubst wl-set-string-width (width string &optional padding ignore-invalid)
   "Make a new string which have specified WIDTH and content of STRING.
+`wl-invalid-character-message' is used when invalid character is contained.
 If WIDTH is negative number, padding chars are added to the head and
 otherwise, padding chars are added to the tail of the string.
 The optional 3rd arg PADDING, if non-nil, specifies a padding character
-to add the result instead of white space."
+to add the result instead of white space.
+If optional 4th argument is non-nil, don't use `wl-invalid-character-message'
+even when invalid character is contained."
   (static-cond
    ((and (fboundp 'string-width) (fboundp 'truncate-string-to-width)
         (not (featurep 'xemacs)))
@@ -186,16 +189,17 @@ to add the result instead of white space."
        (setq string (truncate-string-to-width string (abs width))))
     (if (= (string-width string) (abs width))
        string
-      (if (< (abs width) (string-width string))
-         (wl-set-string-width width
-                              wl-invalid-character-message
-                              padding)
-       (let ((paddings (make-string
-                        (max 0 (- (abs width) (string-width string)))
-                        (or padding ?\ ))))
-         (if (< width 0)
-             (concat paddings string)
-           (concat string paddings))))))
+      (when (and (not ignore-invalid)
+                (< (abs width) (string-width string)))
+       (setq string
+             (truncate-string-to-width wl-invalid-character-message
+                                       (abs width))))
+      (let ((paddings (make-string
+                      (max 0 (- (abs width) (string-width string)))
+                      (or padding ?\ ))))
+       (if (< width 0)
+           (concat paddings string)
+         (concat string paddings)))))
    (t
     (elmo-set-work-buf
      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
@@ -576,7 +580,8 @@ that `read' can handle, whenever this is possible."
     result))
 
 (static-if (fboundp 'read-directory-name)
-    (defalias 'wl-read-directory-name 'read-directory-name)
+    (defun wl-read-directory-name (prompt dir)
+      (read-directory-name prompt dir dir))
   (defun wl-read-directory-name (prompt dir)
     (let ((dir (read-file-name prompt dir)))
       (unless (file-directory-p dir)
@@ -662,7 +667,7 @@ that `read' can handle, whenever this is possible."
 (defvar wl-load-profile-function 'wl-local-load-profile)
 (defun wl-local-load-profile ()
   "Load `wl-init-file'."
-  (message "Initializing ...")
+  (message "Initializing...")
   (load wl-init-file 'noerror 'nomessage))
 
 (defun wl-load-profile ()
@@ -841,7 +846,7 @@ This function is imported from Emacs 20.7."
 
 (defun wl-biff-check-folder (folder)
   (if (eq (elmo-folder-type-internal folder) 'pop3)
-      (unless (elmo-pop3-get-session folder 'if-exists)
+      (unless (elmo-pop3-get-session folder 'any-exists)
        (wl-folder-check-one-entity (elmo-folder-name-internal folder)
                                    'biff))
     (wl-folder-check-one-entity (elmo-folder-name-internal folder)
@@ -892,38 +897,13 @@ is enclosed by at least one regexp grouping construct."
       (concat open-paren (mapconcat 'regexp-quote strings "\\|")
              close-paren))))
 
-(defun wl-expand-newtext (newtext original)
-  (let ((len (length newtext))
-       (pos 0)
-       c expanded beg N did-expand)
-    (while (< pos len)
-      (setq beg pos)
-      (while (and (< pos len)
-                 (not (= (aref newtext pos) ?\\)))
-       (setq pos (1+ pos)))
-      (unless (= beg pos)
-       (push (substring newtext beg pos) expanded))
-      (when (< pos len)
-       ;; We hit a \; expand it.
-       (setq did-expand t
-             pos (1+ pos)
-             c (aref newtext pos))
-       (if (not (or (= c ?\&)
-                    (and (>= c ?1)
-                         (<= c ?9))))
-           ;; \ followed by some character we don't expand.
-           (push (char-to-string c) expanded)
-         ;; \& or \N
-         (if (= c ?\&)
-             (setq N 0)
-           (setq N (- c ?0)))
-         (when (match-beginning N)
-           (push (substring original (match-beginning N) (match-end N))
-                 expanded))))
-      (setq pos (1+ pos)))
-    (if did-expand
-       (apply (function concat) (nreverse expanded))
-      newtext)))
+(defalias 'wl-expand-newtext 'elmo-expand-newtext)
+
+(defun wl-region-exists-p ()
+  "Return non-nil if a region exists on current buffer."
+  (static-if (featurep 'xemacs)
+      (and zmacs-regions zmacs-region-active-p)
+    (and transient-mark-mode mark-active)))
 
 (defvar wl-line-string)
 (defun wl-line-parse-format (format spec-alist)