projects / elisp / wanderlust.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
* wl-vars.el (wl-message-id-use-wl-from): New variable.
[elisp/wanderlust.git] / wl / wl-util.el
diff --git a/wl/wl-util.el b/wl/wl-util.el
index 780ea75..54d53a3 100644 (file)
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -1,4 +1,4 @@
-;;; wl-util.el -- Utility modules for Wanderlust.
+;;; wl-util.el --- Utility modules for Wanderlust.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 ;; Copyright (C) 2000 A. SAGATA <sagata@nttvdt.hil.ntt.co.jp>
@@ -174,23 +174,35 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 ;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
 
 (defsubst wl-set-string-width (width string)
-  (elmo-set-work-buf
-   (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-   (insert string)
-   (if (> (current-column) width)
-       (if (> (move-to-column width) width)
-          (progn
-            (condition-case nil ; ignore error
-                (backward-char 1)
-              (error))
-            (concat (buffer-substring (point-min) (point)) " "))
-        (buffer-substring (point-min) (point)))
-     (if (= (current-column) width)
-        string
-       (concat string
-              (format (format "%%%ds"
-                              (- width (current-column)))
-                      " "))))))
+  (static-cond
+   ((and (fboundp 'string-width) (fboundp 'truncate-string-to-width)
+        (not (featurep 'xemacs)))
+    (if (> (string-width string) width)
+       (setq string (truncate-string-to-width string width)))
+    (if (= (string-width string) width)
+       string
+      (concat string
+             (format (format "%%%ds"
+                             (- width (string-width string)))
+                     " "))))
+   (t
+    (elmo-set-work-buf
+     (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+     (insert string)
+     (if (> (current-column) width)
+        (if (> (move-to-column width) width)
+            (progn
+              (condition-case nil ; ignore error
+                  (backward-char 1)
+                (error))
+              (concat (buffer-substring (point-min) (point)) " "))
+          (buffer-substring (point-min) (point)))
+       (if (= (current-column) width)
+          string
+        (concat string
+                (format (format "%%%ds"
+                                (- width (current-column)))
+                        " "))))))))
 
 (defun wl-display-bytes (num)
   (let (result remain)
@@ -501,14 +513,14 @@ that `read' can handle, whenever this is possible."
         "^nntp://\\([^:/]*\\):?\\([0-9]*\\)/\\([^/]*\\)/\\([0-9]*\\).*$" url)
        (progn
          (if (eq (length (setq fld-name
-                                (elmo-match-string 3 url))) 0)
-              (setq fld-name nil))
+                               (elmo-match-string 3 url))) 0)
+             (setq fld-name nil))
          (if (eq (length (setq port
                                (elmo-match-string 2 url))) 0)
-              (setq port (int-to-string elmo-nntp-default-port)))
+             (setq port (int-to-string elmo-nntp-default-port)))
          (if (eq (length (setq server
-                                (elmo-match-string 1 url))) 0)
-              (setq server elmo-nntp-default-server))
+                               (elmo-match-string 1 url))) 0)
+             (setq server elmo-nntp-default-server))
          (setq folder (concat "-" fld-name "@" server ":" port))
          (if (eq (length (setq msg
                                (elmo-match-string 4 url))) 0)
@@ -527,7 +539,7 @@ that `read' can handle, whenever this is possible."
 (defmacro wl-current-message-buffer ()
   (` (save-excursion
        (if (buffer-live-p wl-current-summary-buffer)
-           (set-buffer wl-current-summary-buffer))
+          (set-buffer wl-current-summary-buffer))
        wl-message-buffer)))
 
 (defmacro wl-kill-buffers (regexp)
@@ -626,16 +638,24 @@ that `read' can handle, whenever this is possible."
      ;; Append the name of the message interface, because while the
      ;; generated ID is unique to this newsreader, other newsreaders
      ;; might otherwise generate the same ID via another algorithm.
-     ".wl")))
+     wl-unique-id-suffix)))
 
 (defun wl-draft-make-message-id-string ()
   "Return Message-ID field value."
-  (concat "<" (wl-unique-id) "@"
-         (or wl-message-id-domain
-             (if wl-local-domain
-                 (concat (system-name) "." wl-local-domain)
-               (system-name)))
-         ">"))
+  (concat "<" (wl-unique-id)
+         (let (from user domain)
+           (if (and wl-message-id-use-wl-from
+                    (progn
+                      (setq from (wl-address-header-extract-address wl-from))
+                      (and (string-match "^\\(.*\\)@\\(.*\\)$" from)
+                           (setq user   (match-string 1 from))
+                           (setq domain (match-string 2 from)))))
+               (format "%%%s@%s>" user domain)
+             (format "@%s>"
+                     (or wl-message-id-domain
+                         (if wl-local-domain
+                             (concat (system-name) "." wl-local-domain)
+                           (system-name))))))))
 
 ;;; Profile loading.
 (defvar wl-load-profile-function 'wl-local-load-profile)
@@ -806,7 +826,7 @@ This function is imported from Emacs 20.7."
          folder)
       (if (eq (length flist) 1)
          (wl-biff-check-folder-async (wl-folder-get-elmo-folder
-                                      (car flist)) (interactive-p))
+                                      (car flist) 'biff) (interactive-p))
        (unwind-protect
            (while flist
              (setq folder (wl-folder-get-elmo-folder (car flist))
@@ -821,12 +841,10 @@ 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)
-       ;; Currently no main pop3 process.
-       (let ((elmo-network-session-name-prefix "BIFF-"))
-         (wl-folder-check-one-entity
-          (elmo-folder-name-internal folder))))
-    (let ((elmo-network-session-name-prefix "BIFF-"))
-      (wl-folder-check-one-entity (elmo-folder-name-internal folder)))))
+       (wl-folder-check-one-entity (elmo-folder-name-internal folder)
+                                   'biff))
+    (wl-folder-check-one-entity (elmo-folder-name-internal folder)
+                               'biff)))
 
 (defun wl-biff-check-folder-async-callback (diff data)
   (if (nth 1 data)
@@ -844,6 +862,7 @@ This function is imported from Emacs 20.7."
 
 (defun wl-biff-check-folder-async (folder notify-minibuf)
   (when (elmo-folder-plugged-p folder)
+    (elmo-folder-set-biff-internal folder t)
     (if (and (eq (elmo-folder-type-internal folder) 'imap4)
             (elmo-folder-use-flag-p folder))
        ;; Check asynchronously only when IMAP4 and use server diff.
@@ -854,8 +873,7 @@ This function is imported from Emacs 20.7."
                (list (elmo-folder-name-internal folder)
                      (get-buffer wl-folder-buffer-name)
                      notify-minibuf))
-         (let ((elmo-network-session-name-prefix "BIFF-"))
-           (elmo-folder-diff-async folder)))
+         (elmo-folder-diff-async folder))
       (unwind-protect
          (wl-biff-notify (car (wl-biff-check-folder folder))
                          notify-minibuf)