(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))
+
(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."
(as-binary-input-file
(insert-file-contents filename))
(when mime-charset
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(decode-mime-charset-region (point-min) (point-max) mime-charset))
(condition-case nil
(read (current-buffer))
(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)))
(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
(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)))))
(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)
(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-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 ()
(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)
(t
(elmo-set-work-buf
(as-binary-input-file (insert-file-contents file))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
;; Should consider charset?
(decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
(setq result
"Normalize MIME encoded STRING."
(and string
(elmo-set-work-buf
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (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)
+ (set-buffer-multibyte nil)
string)))
(defsubst elmo-collect-field (beg end downcase-field-name)
(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-set-work-buf
+ (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-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."
(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"))) ">"))))
projects / elisp / wanderlust.git / blobdiff