(require 'poem)
(require 'emu)
-(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)))
+(eval-and-compile
+ (autoload 'md5 "md5"))
(defvar elmo-work-buf-name " *elmo work*")
(defvar elmo-temp-buf-name " *elmo temp*")
"Execute BODY on work buffer. Work buffer remains."
(` (save-excursion
(set-buffer (get-buffer-create elmo-work-buf-name))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(erase-buffer)
(,@ body))))
+(put 'elmo-set-work-buf 'lisp-indent-function 0)
+(def-edebug-spec elmo-set-work-buf t)
+
(defmacro elmo-bind-directory (dir &rest body)
"Set current directory DIR and execute BODY."
(` (let ((default-directory (file-name-as-directory (, dir))))
(,@ body))))
+(put 'elmo-bind-directory 'lisp-indent-function 1)
+(def-edebug-spec elmo-bind-directory
+ (form &rest form))
+
+(defconst elmo-multibyte-buffer-name " *elmo-multibyte-buffer*")
+
+(defmacro elmo-with-enable-multibyte (&rest body)
+ "Evaluate BODY with `default-enable-multibyte-character'."
+ `(with-current-buffer (get-buffer-create elmo-multibyte-buffer-name)
+ ,@body))
+
+(put 'elmo-with-enable-multibyte 'lisp-indent-function 0)
+(def-edebug-spec elmo-with-enable-multibyte t)
+
(defun elmo-object-load (filename &optional mime-charset no-err)
"Load OBJECT from the file specified by FILENAME.
File content is decoded with MIME-CHARSET."
- (if (not (file-readable-p filename))
- nil
- (elmo-set-work-buf
- (as-binary-input-file
- (insert-file-contents filename))
- (when mime-charset
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (decode-mime-charset-region (point-min) (point-max) mime-charset))
- (condition-case nil
- (read (current-buffer))
- (error (unless no-err
- (message "Warning: Loading object from %s failed."
- filename)
- (elmo-object-save filename nil))
- nil)))))
+ (if (not (file-readable-p filename))
+ nil
+ (with-temp-buffer
+ (insert-file-contents-as-binary filename)
+ (let ((coding-system (or (funcall set-auto-coding-function
+ filename
+ (- (point-max) (point-min)))
+ (mime-charset-to-coding-system
+ mime-charset))))
+ (when coding-system
+ (decode-coding-region (point-min) (point-max) coding-system)))
+ (goto-char (point-min))
+ (condition-case nil
+ (read (current-buffer))
+ (error (unless no-err
+ (message "Warning: Loading object from %s failed."
+ filename)
+ (elmo-object-save filename nil mime-charset))
+ nil)))))
(defsubst elmo-save-buffer (filename &optional mime-charset)
"Save current buffer to the file specified by FILENAME.
(if (file-writable-p filename)
(progn
(when mime-charset
-;;; (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+;;; (set-buffer-multibyte default-enable-multibyte-characters)
(encode-mime-charset-region (point-min) (point-max) mime-charset))
(as-binary-output-file
(write-region (point-min) (point-max) filename nil 'no-msg)))
"Save OBJECT to the file specified by FILENAME.
Directory of the file is created if it doesn't exist.
File content is encoded with MIME-CHARSET."
- (elmo-set-work-buf
- (let (print-length print-level)
- (prin1 object (current-buffer)))
-;;;(princ "\n" (current-buffer))
- (elmo-save-buffer filename mime-charset)))
+ (with-temp-buffer
+ (let (print-length print-level)
+ (prin1 object (current-buffer)))
+ (when mime-charset
+ (let ((coding (mime-charset-to-coding-system
+ (or (detect-mime-charset-region (point-min) (point-max))
+ mime-charset))))
+ (goto-char (point-min))
+ (insert ";;; -*- mode: emacs-lisp; coding: "
+ (symbol-name coding) " -*-\n")
+ (encode-coding-region (point-min) (point-max) coding)))
+ (elmo-save-buffer filename)))
;;; Search Condition
(defconst elmo-condition-atom-regexp "[^/ \")|&]*")
-(defun elmo-read-search-condition (default)
- "Read search condition string interactively."
- (elmo-read-search-condition-internal "Search by" default))
-
-(defun elmo-read-search-condition-internal (prompt default)
- (let* ((completion-ignore-case t)
- (field (completing-read
- (format "%s (%s): " prompt default)
- (mapcar 'list
- (append '("AND" "OR"
- "Last" "First" "Flag"
- "From" "Subject" "To" "Cc" "Body"
- "Since" "Before" "ToCc"
- "!From" "!Subject" "!To" "!Cc" "!Body"
- "!Since" "!Before" "!ToCc")
- elmo-msgdb-extra-fields))))
- value)
- (setq field (if (string= field "")
- (setq field default)
- field))
- (cond
- ((or (string= field "AND") (string= field "OR"))
- (concat "("
- (elmo-read-search-condition-internal
- (concat field "(1) Search by") default)
- (if (string= field "AND") "&" "|")
- (elmo-read-search-condition-internal
- (concat field "(2) Search by") default)
- ")"))
- ((string-match "Since\\|Before" field)
- (let ((default (format-time-string "%Y-%m-%d")))
- (setq value (completing-read
- (format "Value for '%s' [%s]: " field default)
- (mapcar (function
- (lambda (x)
- (list (format "%s" (car x)))))
- elmo-date-descriptions)))
- (concat (downcase field) ":"
- (if (equal value "") default value))))
- ((string= field "Flag")
- (setq value (completing-read
- (format "Value for '%s': " field)
- (mapcar 'list
- '("unread" "important" "answered" "digest" "any"))))
- (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
- value)
- (setq value (prin1-to-string value)))
- (concat (downcase field) ":" value))
- (t
- (setq value (read-from-minibuffer (format "Value for '%s': " field)))
- (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
- value)
- (setq value (prin1-to-string value)))
- (concat (downcase field) ":" value)))))
-
(defsubst elmo-condition-parse-error ()
(error "Syntax error in '%s'" (buffer-string)))
(goto-char (match-end 0))))
;; search-key ::= [A-Za-z-]+
;; ;; "since" / "before" / "last" / "first" /
-;; ;; "body" / "mark" / field-name
+;; ;; "body" / "flag" / field-name
((looking-at "\\(!\\)? *\\([A-Za-z-]+\\) *: *")
(goto-char (match-end 0))
(let ((search-key (vector
(if (match-beginning 1) 'unmatch 'match)
- (elmo-match-buffer 2)
+ (downcase (elmo-match-buffer 2))
(elmo-condition-parse-search-value))))
;; syntax sugar.
(if (string= (aref search-key 1) "tocc")
(cond
((looking-at "\"")
(read (current-buffer)))
- ((or (looking-at "yesterday") (looking-at "lastweek")
+ ((or (looking-at elmo-condition-atom-regexp)
+ (looking-at "yesterday") (looking-at "lastweek")
(looking-at "lastmonth") (looking-at "lastyear")
(looking-at "[0-9]+ *daysago")
(looking-at "[0-9]+-[A-Za-z]+-[0-9]+")
(looking-at "[0-9]+-[0-9]+-[0-9]+")
- (looking-at "[0-9]+")
- (looking-at elmo-condition-atom-regexp))
+ (looking-at "[0-9]+"))
(prog1 (elmo-match-buffer 0)
(goto-char (match-end 0))))
(t (error "Syntax error '%s'" (buffer-string)))))
+(defmacro elmo-filter-condition-p (filter)
+ `(or (vectorp ,filter) (consp ,filter)))
+
+(defmacro elmo-filter-type (filter)
+ `(aref ,filter 0))
+
+(defmacro elmo-filter-key (filter)
+ `(aref ,filter 1))
+
+(defmacro elmo-filter-value (filter)
+ `(aref ,filter 2))
+
+(defun elmo-condition-match (condition match-primitive args)
+ (cond
+ ((vectorp condition)
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (not (apply match-primitive condition args))
+ (apply match-primitive condition args)))
+ ((eq (car condition) 'and)
+ (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-condition-match (nth 2 condition)
+ match-primitive args)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-condition-match (nth 2 condition) match-primitive args)))))
+ ((eq (car condition) 'or)
+ (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-condition-match (nth 2 condition)
+ match-primitive args)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'or lhs rhs))
+ (rhs
+ t)
+ (t
+ lhs))))
+ (lhs
+ t)
+ (t
+ (elmo-condition-match (nth 2 condition) match-primitive args)))))))
+
+(defun elmo-condition-optimize (condition)
+ (cond
+ ((vectorp condition)
+ (let ((key (elmo-filter-key condition)))
+ (cond ((cdr (assoc key '(("first" . 0)
+ ("last" . 0)
+ ("flag" . 1)
+ ("body" . 5)))))
+ ((member key '("since" "before" "from" "subject" "to" "cc"))
+ 2)
+ ((member key elmo-msgdb-extra-fields)
+ 3)
+ (t
+ 4))))
+ (t
+ (let ((weight-l (elmo-condition-optimize (nth 1 condition)))
+ (weight-r (elmo-condition-optimize (nth 2 condition))))
+ (if (> weight-l weight-r)
+ (let ((lhs (nth 1 condition)))
+ (setcar (nthcdr 1 condition) (nth 2 condition))
+ (setcar (nthcdr 2 condition) lhs)
+ weight-l)
+ weight-r)))))
+
;;;
(defsubst elmo-buffer-replace (regexp &optional newtext)
(goto-char (point-min))
(elmo-set-work-buf
(let ((coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion))
- (if unibyte (elmo-set-buffer-multibyte nil))
+ (if unibyte (set-buffer-multibyte nil))
(insert string)
(goto-char (point-min))
(while (search-forward (char-to-string char) nil t)
(replace-match "\n"))
(buffer-string))))
+(defun elmo-last (list)
+ (and list (nth (1- (length list)) list)))
+
+(defun elmo-set-list (vars vals)
+ (while vars
+ (when (car vars)
+ (set (car vars) (car vals)))
+ (setq vars (cdr vars)
+ vals (cdr vals))))
+
(defun elmo-uniq-list (lst &optional delete-function)
"Distractively uniqfy elements of LST."
(setq delete-function (or delete-function #'delete))
(cdr tmp)))))))
lst)
+(defun elmo-uniq-sorted-list (list &optional equal-function)
+ "Distractively uniqfy elements of sorted LIST."
+ (setq equal-function (or equal-function #'equal))
+ (let ((list list))
+ (while list
+ (while (funcall equal-function (car list) (cadr list))
+ (setcdr list (cddr list)))
+ (setq list (cdr list))))
+ list)
+
(defun elmo-list-insert (list element after)
(let* ((match (memq after list))
(rest (and match (cdr (memq after list)))))
(nconc list rest))
(nconc list (list element)))))
-(defun elmo-string-partial-p (string)
- (and (stringp string) (string-match "message/partial" string)))
-
(defun elmo-get-file-string (filename &optional remove-final-newline)
(elmo-set-work-buf
(let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
(defun elmo-concat-path (path filename)
(if (not (string= path ""))
- (if (string= elmo-path-sep (substring path (- (length path) 1)))
- (concat path filename)
- (concat path elmo-path-sep filename))
+ (elmo-replace-in-string
+ (if (string= elmo-path-sep (substring path (- (length path) 1)))
+ (concat path filename)
+ (concat path elmo-path-sep filename))
+ (concat (regexp-quote elmo-path-sep)(regexp-quote elmo-path-sep))
+ elmo-path-sep)
filename))
(defvar elmo-passwd-alist nil)
(defun elmo-passwd-alist-load ()
- (save-excursion
+ (with-temp-buffer
(let ((filename (expand-file-name elmo-passwd-alist-file-name
elmo-msgdb-directory))
- (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))))
- (kill-buffer tmp-buffer)
- ret-val)))
+ (condition-case nil
+ (read (current-buffer))
+ (error nil nil))))))
(defun elmo-passwd-alist-clear ()
"Clear password cache."
(interactive)
+ (dolist (pair elmo-passwd-alist)
+ (when (stringp (cdr-safe pair))
+ (fillarray (cdr pair) 0)))
(setq elmo-passwd-alist nil))
(defun elmo-passwd-alist-save ()
"Save password into file."
(interactive)
- (save-excursion
+ (with-temp-buffer
(let ((filename (expand-file-name elmo-passwd-alist-file-name
elmo-msgdb-directory))
- (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
print-length print-level)
- (set-buffer tmp-buffer)
- (erase-buffer)
- (prin1 elmo-passwd-alist tmp-buffer)
- (princ "\n" tmp-buffer)
+ (prin1 elmo-passwd-alist (current-buffer))
+ (princ "\n" (current-buffer))
;;; (if (and (file-exists-p filename)
;;; (not (equal 384 (file-modes filename))))
;;; (error "%s is not safe.chmod 600 %s!" filename filename))
(write-region (point-min) (point-max)
filename nil 'no-msg)
(set-file-modes filename 384))
- (message "%s is not writable." filename))
- (kill-buffer tmp-buffer))))
+ (message "%s is not writable." filename)))))
(defun elmo-get-passwd (key)
"Get password from password pool."
(defun elmo-remove-passwd (key)
"Remove password from password pool (for failure)."
(let (pass-cons)
- (if (setq pass-cons (assoc key elmo-passwd-alist))
- (progn
- (unwind-protect
- (fillarray (cdr pass-cons) 0))
- (setq elmo-passwd-alist
- (delete pass-cons elmo-passwd-alist))))))
+ (while (setq pass-cons (assoc key elmo-passwd-alist))
+ (unwind-protect
+ (fillarray (cdr pass-cons) 0)
+ (setq elmo-passwd-alist
+ (delete pass-cons elmo-passwd-alist))))))
(defmacro elmo-read-char-exclusive ()
(cond ((featurep 'xemacs)
(dolist (file (directory-files path t regexp))
(delete-file file))
(if remove-if-empty
- (ignore-errors
+ (ignore-errors
(delete-directory path) ; should be removed if empty.
))))
(setq list (cdr list)))
ret-val))
-(defun elmo-list-diff (list1 list2 &optional mes)
- (if mes
- (message "%s" mes))
+(defun elmo-list-diff (list1 list2)
+ (let ((clist1 (sort (copy-sequence list1) #'<))
+ (clist2 (sort (copy-sequence list2) #'<))
+ list1-only list2-only)
+ (while (or clist1 clist2)
+ (cond
+ ((null clist1)
+ (while clist2
+ (setq list2-only (cons (car clist2) list2-only))
+ (setq clist2 (cdr clist2))))
+ ((null clist2)
+ (while clist1
+ (setq list1-only (cons (car clist1) list1-only))
+ (setq clist1 (cdr clist1))))
+ ((< (car clist1) (car clist2))
+ (while (and clist1 (< (car clist1) (car clist2)))
+ (setq list1-only (cons (car clist1) list1-only))
+ (setq clist1 (cdr clist1))))
+ ((< (car clist2) (car clist1))
+ (while (and clist2 (< (car clist2) (car clist1)))
+ (setq list2-only (cons (car clist2) list2-only))
+ (setq clist2 (cdr clist2))))
+ ((= (car clist1) (car clist2))
+ (setq clist1 (cdr clist1)
+ clist2 (cdr clist2)))))
+ (list list1-only list2-only)))
+
+(defun elmo-list-diff-nonsortable (list1 list2)
(let ((clist1 (copy-sequence list1))
(clist2 (copy-sequence list2)))
(while list2
(while list1
(setq clist2 (delq (car list1) clist2))
(setq list1 (cdr list1)))
- (if mes
- (message "%sdone" mes))
(list clist1 clist2)))
(defun elmo-list-bigger-diff (list1 list2 &optional mes)
(setq l1 (cdr l1)))
(cons diff1 (list l2)))))
-(defmacro elmo-filter-condition-p (filter)
- `(or (vectorp ,filter) (consp ,filter)))
-
-(defmacro elmo-filter-type (filter)
- (` (aref (, filter) 0)))
-
-(defmacro elmo-filter-key (filter)
- (` (aref (, filter) 1)))
-
-(defmacro elmo-filter-value (filter)
- (` (aref (, filter) 2)))
-
-(defsubst elmo-buffer-field-primitive-condition-match (condition
- number
- number-list)
- (let (result)
- (goto-char (point-min))
- (cond
- ((string= (elmo-filter-key condition) "last")
- (setq result (<= (length (memq number number-list))
- (string-to-int (elmo-filter-value condition)))))
- ((string= (elmo-filter-key condition) "first")
- (setq result (< (- (length number-list)
- (length (memq number number-list)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= (elmo-filter-key condition) "since")
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (std11-field-body "date")
- (current-time-zone) nil)))
- (specified-date (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition)))))
- (setq result
- (or (string= field-date specified-date)
- (string< specified-date field-date)))))
- ((string= (elmo-filter-key condition) "before")
- (setq result
- (string<
- (elmo-date-make-sortable-string
- (timezone-fix-time
- (std11-field-body "date")
- (current-time-zone) nil))
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition))))))
- ((string= (elmo-filter-key condition) "body")
- (and (re-search-forward "^$" nil t) ; goto body
- (setq result (search-forward (elmo-filter-value condition)
- nil t))))
- (t
- (dolist (fval (elmo-multiple-field-body (elmo-filter-key condition)))
- (if (eq (length fval) 0) (setq fval nil))
- (if fval (setq fval (eword-decode-string fval)))
- (setq result (or result
- (and fval (string-match
- (elmo-filter-value condition) fval)))))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result)))
- result))
-
-(defun elmo-condition-in-msgdb-p-internal (condition fields)
- (cond
- ((vectorp condition)
- (if (not (member (elmo-filter-key condition) fields))
- (throw 'found t)))
- ((or (eq (car condition) 'and)
- (eq (car condition) 'or))
- (elmo-condition-in-msgdb-p-internal (nth 1 condition) fields)
- (elmo-condition-in-msgdb-p-internal (nth 2 condition) fields))))
-
-(defun elmo-condition-in-msgdb-p (condition)
- (not (catch 'found
- (elmo-condition-in-msgdb-p-internal condition
- (append
- elmo-msgdb-extra-fields
- '("last" "first" "from"
- "subject" "to" "cc" "since"
- "before"))))))
-
-(defun elmo-buffer-field-condition-match (condition number number-list)
- (cond
- ((vectorp condition)
- (elmo-buffer-field-primitive-condition-match
- condition number number-list))
- ((eq (car condition) 'and)
- (and (elmo-buffer-field-condition-match
- (nth 1 condition) number number-list)
- (elmo-buffer-field-condition-match
- (nth 2 condition) number number-list)))
- ((eq (car condition) 'or)
- (or (elmo-buffer-field-condition-match
- (nth 1 condition) number number-list)
- (elmo-buffer-field-condition-match
- (nth 2 condition) number number-list)))))
-
-(defsubst elmo-file-field-primitive-condition-match (file
- condition
- number
- number-list)
- (let (result)
- (goto-char (point-min))
- (cond
- ((string= (elmo-filter-key condition) "last")
- (setq result (<= (length (memq number number-list))
- (string-to-int (elmo-filter-value condition))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result))))
- ((string= (elmo-filter-key condition) "first")
- (setq result (< (- (length number-list)
- (length (memq number number-list)))
- (string-to-int (elmo-filter-value condition))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result))))
- (t
- (elmo-set-work-buf
- (as-binary-input-file (insert-file-contents file))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- ;; Should consider charset?
- (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
- (setq result
- (elmo-buffer-field-primitive-condition-match
- condition number number-list)))))
- result))
-
-(defun elmo-file-field-condition-match (file condition number number-list)
- (cond
- ((vectorp condition)
- (elmo-file-field-primitive-condition-match
- file condition number number-list))
- ((eq (car condition) 'and)
- (and (elmo-file-field-condition-match
- file (nth 1 condition) number number-list)
- (elmo-file-field-condition-match
- file (nth 2 condition) number number-list)))
- ((eq (car condition) 'or)
- (or (elmo-file-field-condition-match
- file (nth 1 condition) number number-list)
- (elmo-file-field-condition-match
- file (nth 2 condition) number number-list)))))
-
(defmacro elmo-get-hash-val (string hashtable)
(static-if (fboundp 'unintern)
`(symbol-value (intern-soft ,string ,hashtable))
(defsubst elmo-mime-string (string)
"Normalize MIME encoded STRING."
(and string
- (elmo-set-work-buf
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq string
- (encode-mime-charset-string
- (eword-decode-and-unfold-unstructured-field-body
- string)
- elmo-mime-charset))
- (elmo-set-buffer-multibyte nil)
- string)))
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string
+ (eword-decode-and-unfold-unstructured-field-body string)
+ elmo-mime-charset))))
(defsubst elmo-collect-field (beg end downcase-field-name)
(save-excursion
(let (result)
(while lst
(unless (funcall pred (car lst))
- (setq result (nconc result (list (car lst)))))
+ (setq result (cons (car lst) result)))
(setq lst (cdr lst)))
- result))
+ (nreverse result)))
(defun elmo-list-delete (list1 list2 &optional delete-function)
"Delete by side effect any occurrences equal to elements of LIST1 from LIST2.
(and value
(std11-unfold-string value))))
+(defun elmo-decoded-field-body (field-name &optional mode)
+ (let ((field-body (elmo-field-body field-name)))
+ (and field-body
+ (elmo-with-enable-multibyte
+ (mime-decode-field-body field-body field-name mode)))))
+
(defun elmo-address-quote-specials (word)
"Make quoted string of WORD if needed."
(let ((lal (std11-lexical-analyze word)))
(throw 'found t))
(setq slist (cdr slist)))))
-(cond ((fboundp 'member-ignore-case)
+(static-cond ((fboundp 'member-ignore-case)
(defalias 'elmo-string-member-ignore-case 'member-ignore-case))
((fboundp 'compare-strings)
(defun elmo-string-member-ignore-case (elt list)
(setq number-set-1 (nconc number-set-1 (list number))))
number-set-1))
+(defun elmo-number-set-delete-list (number-set list)
+ "Delete LIST of numbers from the NUMBER-SET.
+NUMBER-SET is altered."
+ (let ((deleted number-set))
+ (dolist (number list)
+ (setq deleted (elmo-number-set-delete deleted number)))
+ deleted))
+
+(defun elmo-number-set-delete (number-set number)
+ "Delete NUMBER from the NUMBER-SET.
+NUMBER-SET is altered."
+ (let* ((curr number-set)
+ (top (cons 'dummy number-set))
+ (prev top)
+ elem found)
+ (while (and curr (not found))
+ (setq elem (car curr))
+ (if (consp elem)
+ (cond
+ ((eq (car elem) number)
+ (if (eq (cdr elem) (1+ number))
+ (setcar curr (cdr elem))
+ (setcar elem (1+ number)))
+ (setq found t))
+ ((eq (cdr elem) number)
+ (if (eq (car elem) (1- number))
+ (setcar curr (car elem))
+ (setcdr elem (1- number)))
+ (setq found t))
+ ((and (> number (car elem))
+ (< number (cdr elem)))
+ (setcdr
+ prev
+ (nconc
+ (list
+ ;; (beg . (1- number))
+ (let ((new (cons (car elem) (1- number))))
+ (if (eq (car new) (cdr new))
+ (car new)
+ new))
+ ;; ((1+ number) . end)
+ (let ((new (cons (1+ number) (cdr elem))))
+ (if (eq (car new) (cdr new))
+ (car new)
+ new)))
+ (cdr curr)))))
+ (when (eq elem number)
+ (setcdr prev (cdr curr))
+ (setq found t)))
+ (setq prev curr
+ curr (cdr curr)))
+ (cdr top)))
+
+(defun elmo-make-number-list (beg end)
+ (let (number-list i)
+ (setq i end)
+ (while (>= i beg)
+ (setq number-list (cons i number-list))
+ (setq i (1- i)))
+ number-list))
+
(defun elmo-number-set-to-number-list (number-set)
"Return a number list which corresponds to NUMBER-SET."
- (let (number-list elem i)
+ (let ((number-list (list 'dummy))
+ elem)
(while number-set
(setq elem (car number-set))
(cond
((consp elem)
- (setq i (car elem))
- (while (<= i (cdr elem))
- (setq number-list (cons i number-list))
- (incf i)))
+ (nconc number-list (elmo-make-number-list (car elem) (cdr elem))))
((integerp elem)
- (setq number-list (cons elem number-list))))
+ (nconc number-list (list elem))))
(setq number-set (cdr number-set)))
- (nreverse number-list)))
+ (cdr number-list)))
(defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
"*Regexp to filter subfolders."
(t (funcall func x))))
list-of-list))
+(defun elmo-map-recursive (function object)
+ (let* ((prev (list 'dummy))
+ (result prev))
+ (while (consp object)
+ (setq prev (setcdr prev (list (elmo-map-recursive function (car object))))
+ object (cdr object)))
+ (when object
+ (setcdr prev (funcall function object)))
+ (cdr result)))
+
(defun elmo-parse (string regexp &optional matchn)
(or matchn (setq matchn 1))
(let (list)
(if msgid
(if (string-match "<\\(.+\\)>$" msgid)
msgid
- (concat "<" msgid ">")) ; Invaild message-id.
+ (concat "<" msgid ">")) ; Invaild message-id.
;; no message-id, so put dummy msgid.
- (concat "<" (timezone-make-date-sortable
- (elmo-unfold-field-body "date"))
+ (concat "<"
+ (if (elmo-unfold-field-body "date")
+ (timezone-make-date-sortable (elmo-unfold-field-body "date"))
+ (md5 (string-as-unibyte (buffer-string))))
(nth 1 (eword-extract-address-components
(or (elmo-field-body "from") "nobody"))) ">"))))
+(defun elmo-msgdb-get-references-from-buffer ()
+ (if elmo-msgdb-prefer-in-reply-to-for-parent
+ (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to"))
+ (elmo-msgdb-get-last-message-id (elmo-field-body "references")))
+ (or (elmo-msgdb-get-last-message-id (elmo-field-body "references"))
+ (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")))))
+
(defsubst elmo-msgdb-insert-file-header (file)
"Insert the header of the article."
(let ((beg 0)
(match-end 0) (std11-field-end))))))
field-body))))
+(defun elmo-parse-addresses (string)
+ (if (null string)
+ ()
+ (elmo-set-work-buf
+ (let (list start s char)
+ (insert string)
+ (goto-char (point-min))
+ (skip-chars-forward "\t\f\n\r ")
+ (setq start (point))
+ (while (not (eobp))
+ (skip-chars-forward "^\"\\,(")
+ (setq char (following-char))
+ (cond ((= char ?\\)
+ (forward-char 1)
+ (if (not (eobp))
+ (forward-char 1)))
+ ((= char ?,)
+ (setq s (buffer-substring start (point)))
+ (if (or (null (string-match "^[\t\f\n\r ]+$" s))
+ (not (string= s "")))
+ (setq list (cons s list)))
+ (skip-chars-forward ",\t\f\n\r ")
+ (setq start (point)))
+ ((= char ?\")
+ (re-search-forward "[^\\]\"" nil 0))
+ ((= char ?\()
+ (let ((parens 1))
+ (forward-char 1)
+ (while (and (not (eobp)) (not (zerop parens)))
+ (re-search-forward "[()]" nil 0)
+ (cond ((or (eobp)
+ (= (char-after (- (point) 2)) ?\\)))
+ ((= (preceding-char) ?\()
+ (setq parens (1+ parens)))
+ (t
+ (setq parens (1- parens)))))))))
+ (setq s (buffer-substring start (point)))
+ (if (and (null (string-match "^[\t\f\n\r ]+$" s))
+ (not (string= s "")))
+ (setq list (cons s list)))
+ (nreverse list)))))
+
;;; Queue.
(defvar elmo-dop-queue-filename "queue"
"*Disconnected operation queue is saved in this file.")
projects / elisp / wanderlust.git / blobdiff