-;;; elmo-util.el -- Utilities for Elmo.
+;;; elmo-util.el --- Utilities for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
(require 'elmo-vars)
(defmacro elmo-set-buffer-multibyte (flag)
"Set the multibyte flag of the current buffer to FLAG."
(cond ((boundp 'MULE)
- (list 'setq 'mc-flag flag))
- ((featurep 'xemacs)
- flag)
- ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
- (list 'set-buffer-multibyte flag))
- (t
- flag)))
+ (list 'setq 'mc-flag flag))
+ ((featurep 'xemacs)
+ flag)
+ ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
+ (list 'set-buffer-multibyte flag))
+ (t
+ flag)))
(defvar elmo-work-buf-name " *elmo work*")
(defvar elmo-temp-buf-name " *elmo temp*")
(elmo-condition-parse-error)))
;; or-expr ::= and-expr /
-;; and-expr "|" or-expr
+;; and-expr "|" or-expr
(defun elmo-condition-parse-or-expr ()
(let ((left (elmo-condition-parse-and-expr)))
(if (looking-at "| *")
(defun elmo-passwd-alist-load ()
(save-excursion
(let ((filename (expand-file-name elmo-passwd-alist-file-name
- elmo-msgdb-dir))
- (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- ret-val)
+ elmo-msgdb-dir))
+ (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
+ insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook
+ ret-val)
(if (not (file-readable-p filename))
- ()
- (set-buffer tmp-buffer)
- (insert-file-contents filename)
- (setq ret-val
- (condition-case nil
- (read (current-buffer))
- (error nil nil))))
+ ()
+ (set-buffer tmp-buffer)
+ (insert-file-contents filename)
+ (setq ret-val
+ (condition-case nil
+ (read (current-buffer))
+ (error nil nil))))
(kill-buffer tmp-buffer)
ret-val)))
"Clear password cache."
(interactive)
(setq elmo-passwd-alist nil))
-
+
(defun elmo-passwd-alist-save ()
"Save password into file."
(interactive)
(save-excursion
(let ((filename (expand-file-name elmo-passwd-alist-file-name
- elmo-msgdb-dir))
- (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
+ elmo-msgdb-dir))
+ (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
(set-buffer tmp-buffer)
(erase-buffer)
(prin1 elmo-passwd-alist tmp-buffer)
;;; (not (equal 384 (file-modes filename))))
;;; (error "%s is not safe.chmod 600 %s!" filename filename))
(if (file-writable-p filename)
- (progn
- (write-region (point-min) (point-max)
- filename nil 'no-msg)
- (set-file-modes filename 384))
- (message (format "%s is not writable." filename)))
+ (progn
+ (write-region (point-min) (point-max)
+ filename nil 'no-msg)
+ (set-file-modes filename 384))
+ (message (format "%s is not writable." filename)))
(kill-buffer tmp-buffer))))
(defun elmo-get-passwd (key)
(defmacro elmo-read-char-exclusive ()
(cond ((featurep 'xemacs)
- '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
- (left . ?\C-h))))
- event key)
- (while (not
- (and
- (key-press-event-p (setq event (next-command-event)))
- (setq key (or (event-to-character event)
- (cdr (assq (event-key event) table)))))))
- key))
- ((fboundp 'read-char-exclusive)
- '(read-char-exclusive))
- (t
- '(read-char))))
+ '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
+ (left . ?\C-h))))
+ event key)
+ (while (not
+ (and
+ (key-press-event-p (setq event (next-command-event)))
+ (setq key (or (event-to-character event)
+ (cdr (assq (event-key event) table)))))))
+ key))
+ ((fboundp 'read-char-exclusive)
+ '(read-char-exclusive))
+ (t
+ '(read-char))))
(defun elmo-read-passwd (prompt &optional stars)
"Read a single line of text from user without echoing, and return it."
(setq tlist (cdr tlist)))
(setq str
(concat str ")")))
- (setq str
+ (setq str
(if (symbolp tlist)
(symbol-name tlist)
tlist)))
str))
-
+
(defun elmo-plug-on-by-servers (alist &optional servers)
(let ((server-list (or servers elmo-plug-on-servers)))
'("last" "first" "from"
"subject" "to" "cc" "since"
"before"))))))
-
+
(defun elmo-buffer-field-condition-match (condition number number-list)
(cond
((vectorp condition)
(defun elmo-make-hash (&optional hashsize)
"Make a new hash table which have HASHSIZE size."
(make-vector
- (if hashsize
+ (if hashsize
(max
;; Prime numbers as lengths tend to result in good
- ;; hashing; lengths one less than a power of two are
+ ;; hashing; lengths one less than a power of two are
;; also good.
(min
(let ((i 1))
(setq filename (substring filename (+ (match-end 0) 1))))
(concat result filename)))
-(defsubst elmo-copy-file (src dst)
+(defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
(condition-case err
- (elmo-add-name-to-file src dst t)
- (error (copy-file src dst t))))
+ (elmo-add-name-to-file src dst ok-if-already-exists)
+ (error (copy-file src dst ok-if-already-exists t))))
(defsubst elmo-buffer-exists-p (buffer)
(if (bufferp buffer)
(apply (function message) (concat format " %d%%")
(nconc args (list value)))))))
+(defvar elmo-progress-counter-alist nil)
+
+(defmacro elmo-progress-counter-value (counter)
+ (` (aref (cdr (, counter)) 0)))
+
+(defmacro elmo-progress-counter-all-value (counter)
+ (` (aref (cdr (, counter)) 1)))
+
+(defmacro elmo-progress-counter-format (counter)
+ (` (aref (cdr (, counter)) 2)))
+
+(defmacro elmo-progress-counter-set-value (counter value)
+ (` (aset (cdr (, counter)) 0 (, value))))
+
+(defun elmo-progress-set (label all-value &optional format)
+ (unless (assq label elmo-progress-counter-alist)
+ (setq elmo-progress-counter-alist
+ (cons (cons label (vector 0 all-value (or format "")))
+ elmo-progress-counter-alist))))
+
+(defun elmo-progress-clear (label)
+ (let ((counter (assq label elmo-progress-counter-alist)))
+ (when counter
+ (elmo-display-progress label "" 100)
+ (setq elmo-progress-counter-alist
+ (delq counter elmo-progress-counter-alist)))))
+
+(defun elmo-progress-notify (label &optional value op &rest args)
+ (let ((counter (assq label elmo-progress-counter-alist)))
+ (when counter
+ (let* ((value (or value 1))
+ (cur-value (elmo-progress-counter-value counter))
+ (all-value (elmo-progress-counter-all-value counter))
+ (new-value (if (eq op 'set) value (+ cur-value value)))
+ (cur-rate (/ (* cur-value 100) all-value))
+ (new-rate (/ (* new-value 100) all-value)))
+ (elmo-progress-counter-set-value counter new-value)
+ (unless (= cur-rate new-rate)
+ (apply 'elmo-display-progress
+ label
+ (elmo-progress-counter-format counter)
+ new-rate
+ args))
+ (when (>= new-rate 100)
+ (elmo-progress-clear label))))))
+
(defun elmo-time-expire (before-time diff-time)
(let* ((current (current-time))
(rest (when (< (nth 1 current) (nth 1 before-time))
(defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
(defalias 'elmo-field-body 'std11-field-body))
+(defun elmo-address-quote-specials (word)
+ "Make quoted string of WORD if needed."
+ (let ((lal (std11-lexical-analyze word)))
+ (if (or (assq 'specials lal)
+ (assq 'domain-literal lal))
+ (prin1-to-string word)
+ word)))
+
(defmacro elmo-string (string)
"STRING without text property."
(` (let ((obj (copy-sequence (, string))))
(throw 'loop a))
(setq alist (cdr alist))))))
+(defun elmo-string-assoc-all (key alist)
+ (let (matches)
+ (while alist
+ (if (string= key (car (car alist)))
+ (setq matches
+ (cons (car alist)
+ matches)))
+ (setq alist (cdr alist)))
+ matches))
+
(defun elmo-string-rassoc (key alist)
(let (a)
(catch 'loop
(setq alist (cdr alist)))
matches))
+;;; Folder parser utils.
+(defun elmo-parse-token (string &optional seps)
+ "Parse atom from STRING using SEPS as a string of separator char list."
+ (let ((len (length string))
+ (seps (and seps (string-to-char-list seps)))
+ (i 0)
+ (sep nil)
+ content c in)
+ (if (eq len 0)
+ (cons "" "")
+ (while (and (< i len) (or in (null sep)))
+ (setq c (aref string i))
+ (cond
+ ((and in (eq c ?\\))
+ (setq i (1+ i)
+ content (cons (aref string i) content)
+ i (1+ i)))
+ ((eq c ?\")
+ (setq in (not in)
+ i (1+ i)))
+ (in (setq content (cons c content)
+ i (1+ i)))
+ ((memq c seps)
+ (setq sep c))
+ (t (setq content (cons c content)
+ i (1+ i)))))
+ (if in (error "Parse error in quoted"))
+ (cons (if (null content) "" (char-list-to-string (nreverse content)))
+ (substring string i)))))
+
+(defun elmo-parse-prefixed-element (prefix string &optional seps)
+ (if (and (not (eq (length string) 0))
+ (eq (aref string 0) prefix))
+ (elmo-parse-token (substring string 1) seps)
+ (cons "" string)))
+
;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
-;;
+;;
;; number ::= [0-9]+
;; beg ::= number
;; end ::= number
(store-match-data nil)
(while (string-match regexp string (match-end 0))
(setq list (cons (substring string (match-beginning matchn)
- (match-end matchn)) list)))
+ (match-end matchn)) list)))
(nreverse list)))
;;; File cache.
;;;
;; msgid to path.
(defun elmo-msgid-to-cache (msgid)
- (when (and msgid
- (string-match "<\\(.+\\)>$" msgid))
- (elmo-replace-string-as-filename (elmo-match-string 1 msgid))))
+ (save-match-data
+ (when (and msgid
+ (string-match "<\\(.+\\)>$" msgid))
+ (elmo-replace-string-as-filename (elmo-match-string 1 msgid)))))
(defun elmo-cache-get-path (msgid &optional folder number)
"Get path for cache file associated with MSGID, FOLDER, and NUMBER."