-;;; 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>
(eval-when-compile
(require 'elmo-util))
-(condition-case nil (require 'tm-edit) (error nil))
(condition-case nil (require 'pp) (error nil))
(eval-when-compile
(list 'nconc val func)
(list 'setq val func)))
-(defun wl-parse (string regexp &optional matchn)
- (or matchn (setq matchn 1))
- (let (list)
- (store-match-data nil)
- (while (string-match regexp string (match-end 0))
- (setq list (cons (substring string (match-beginning matchn)
- (match-end matchn)) list)))
- (nreverse list)))
+(defalias 'wl-parse 'elmo-parse)
+(make-obsolete 'wl-parse 'elmo-parse)
(defun wl-delete-duplicates (list &optional all hack-addresses)
"Delete duplicate equivalent strings from the LIST.
;;(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)
(defmacro wl-as-coding-system (coding-system &rest body)
(` (let ((file-coding-system-for-read (, coding-system))
(file-coding-system (, coding-system)))
- (,@ body))))
- (if wl-on-nemacs
- (defmacro wl-as-coding-system (coding-system &rest body)
- (` (let ((default-kanji-fileio-code (, coding-system))
- (kanji-fileio-code (, coding-system))
- kanji-expected-code)
- (,@ body))))))))
+ (,@ body)))))))
(defmacro wl-as-mime-charset (mime-charset &rest body)
(` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset))
(defalias 'wl-string 'elmo-string)
(make-obsolete 'wl-string 'elmo-string)
-(defun wl-parse-newsgroups (string &optional subscribe-only)
- (let* ((nglist (wl-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
- ret-val)
- (if (not subscribe-only)
- nglist
- (while nglist
- (if (intern-soft (car nglist) wl-folder-newsgroups-hashtb)
- (wl-append ret-val (list (car nglist))))
- (setq nglist (cdr nglist)))
- ret-val)))
-
;; Check if active region exists or not.
(if (boundp 'mark-active)
(defmacro wl-region-exists-p ()
"^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-default-nntp-port)))
+ (setq port (int-to-string elmo-nntp-default-port)))
(if (eq (length (setq server
- (elmo-match-string 1 url))) 0)
- (setq server elmo-default-nntp-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)
(defmacro wl-current-message-buffer ()
(` (save-excursion
(if (buffer-live-p wl-current-summary-buffer)
- (set-buffer wl-current-summary-buffer))
- wl-message-buf-name)))
+ (set-buffer wl-current-summary-buffer))
+ wl-message-buffer)))
(defmacro wl-kill-buffers (regexp)
(` (mapcar (function
;; 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-func 'wl-local-load-profile)
+(defvar wl-load-profile-function 'wl-local-load-profile)
(defun wl-local-load-profile ()
"Load `wl-init-file'."
(message "Initializing ...")
(load wl-init-file 'noerror 'nomessage))
(defun wl-load-profile ()
- "Call `wl-load-profile-func' function."
- (funcall wl-load-profile-func))
+ "Call `wl-load-profile-function' function."
+ (funcall wl-load-profile-function))
;;;
(defsubst wl-biff-notify (new-mails notify-minibuf)
(when (and (not wl-modeline-biff-status) (> new-mails 0))
(run-hooks 'wl-biff-notify-hook))
+ (when (and wl-modeline-biff-status (eq new-mails 0))
+ (run-hooks 'wl-biff-unnotify-hook))
(setq wl-modeline-biff-status (> new-mails 0))
(force-mode-line-update t)
(when notify-minibuf
(flist (or wl-biff-check-folder-list (list wl-default-folder)))
folder)
(if (eq (length flist) 1)
- (wl-biff-check-folder-async (car flist) (interactive-p))
+ (wl-biff-check-folder-async (wl-folder-get-elmo-folder
+ (car flist) 'biff) (interactive-p))
(unwind-protect
(while flist
- (setq folder (car flist)
+ (setq folder (wl-folder-get-elmo-folder (car flist))
flist (cdr flist))
(when (elmo-folder-plugged-p folder)
(setq new-mails
(wl-biff-notify new-mails (interactive-p)))))))
(defun wl-biff-check-folder (folder)
- (if (eq (elmo-folder-get-type folder) 'pop3)
- ;; pop3 biff should share the session.
- (prog2
- (elmo-commit folder) ; Close session.
- (wl-folder-check-one-entity folder)
- (elmo-commit folder))
- (let ((elmo-network-session-name-prefix "BIFF-"))
- (wl-folder-check-one-entity folder))))
+ (if (eq (elmo-folder-type-internal folder) 'pop3)
+ (unless (elmo-pop3-get-session folder 'if-exists)
+ (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)
(with-current-buffer (nth 1 data)
- (wl-folder-entity-hashtb-set wl-folder-entity-hashtb (nth 0 data)
- (list (car diff) 0 (cdr diff))
+ (wl-folder-entity-hashtb-set wl-folder-entity-hashtb
+ (nth 0 data)
+ (list (nth 0 diff)
+ (- (nth 1 diff) (nth 0 diff))
+ (nth 2 diff))
(current-buffer))))
(setq wl-folder-info-alist-modified t)
(setq wl-biff-check-folders-running nil)
(defun wl-biff-check-folder-async (folder notify-minibuf)
(when (elmo-folder-plugged-p folder)
- (let ((type (elmo-folder-get-type folder)))
- (if (and (eq type 'imap4)
- (wl-folder-use-server-diff-p folder))
- ;; Check asynchronously only when IMAP4 and use server diff.
- (progn
- (setq elmo-folder-diff-async-callback
- 'wl-biff-check-folder-async-callback)
- (setq elmo-folder-diff-async-callback-data
- (list folder (get-buffer wl-folder-buffer-name)
- notify-minibuf))
- (let ((elmo-network-session-name-prefix "BIFF-"))
- (elmo-folder-diff-async folder)))
- (wl-biff-notify (car (wl-biff-check-folder folder))
- notify-minibuf)
+ (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.
+ (progn
+ (setq elmo-folder-diff-async-callback
+ 'wl-biff-check-folder-async-callback)
+ (setq elmo-folder-diff-async-callback-data
+ (list (elmo-folder-name-internal folder)
+ (get-buffer wl-folder-buffer-name)
+ notify-minibuf))
+ (elmo-folder-diff-async folder))
+ (unwind-protect
+ (wl-biff-notify (car (wl-biff-check-folder folder))
+ notify-minibuf)
(setq wl-biff-check-folders-running nil)))))
(if (and (fboundp 'regexp-opt)
(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)))
+
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))