;;; elmo-util.el -- Utilities for Elmo.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
(require 'eword-decode)
(require 'utf7)
-(eval-when-compile
- (condition-case nil
- (progn
- (require 'ssl)
- (require 'starttls))
- (error))
- (defun-maybe starttls-negotiate (a))
- (defun-maybe starttls-open-stream (a b c d))
- (defun-maybe open-ssl-stream (a b c d)))
-
(defmacro elmo-set-buffer-multibyte (flag)
"Set the multibyte flag of the current buffer to FLAG."
(cond ((boundp 'MULE)
;; base64 encoding/decoding
(require 'mel)
-(fset 'elmo-base64-encode-string
+(fset 'elmo-base64-encode-string
(mel-find-function 'mime-encode-string "base64"))
(fset 'elmo-base64-decode-string
(mel-find-function 'mime-decode-string "base64"))
;; Check make-symbolic-link() instead. -- 981002 by Fuji
(if (fboundp 'make-symbolic-link) ;; xxx
(defalias 'elmo-add-name-to-file 'add-name-to-file)
- (defun elmo-add-name-to-file
+ (defun elmo-add-name-to-file
(filename newname &optional ok-if-already-exists)
(copy-file filename newname ok-if-already-exists t)))
-(require 'broken)
-(broken-facility timezone-y2k
- "timezone.el does not clear Y2K."
- (or (not (featurep 'timezone))
- (string= (aref (timezone-parse-date "Sat, 1 Jan 00 07:00:00 JST") 0)
- "2000")))
-
-(when-broken timezone-y2k
- (defun timezone-parse-date (date)
- "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
-19 is prepended to year if necessary. Timezone may be nil if nothing.
-Understands the following styles:
- (1) 14 Apr 89 03:20[:12] [GMT]
- (2) Fri, 17 Mar 89 4:01[:33] [GMT]
- (3) Mon Jan 16 16:12[:37] [GMT] 1989
- (4) 6 May 1992 1641-JST (Wednesday)
- (5) 22-AUG-1993 10:59:12.82
- (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6 Jul 16:47:20 T 1992 [MET]"
- (condition-case nil
- (progn
- ;; Get rid of any text properties.
- (and (stringp date)
- (or (text-properties-at 0 date)
- (next-property-change 0 date))
- (setq date (copy-sequence date))
- (set-text-properties 0 (length date) nil date))
- (let ((date (or date ""))
- (year nil)
- (month nil)
- (day nil)
- (time nil)
- (zone nil)) ;This may be nil.
- (cond ((string-match
- "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
- ;; Styles: (6) and (7) without timezone
- (setq year 6 month 3 day 2 time 4 zone nil))
- ((string-match
- "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (6) and (7) with timezone and buggy timezone
- (setq year 6 month 3 day 2 time 4 zone 7))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
- ;; Styles: (1) and (2) without timezone
- (setq year 3 month 2 day 1 time 4 zone nil))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (1) and (2) with timezone and buggy timezone
- (setq year 3 month 2 day 1 time 4 zone 5))
- ((string-match
- "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
- ;; Styles: (3) without timezone
- (setq year 4 month 1 day 2 time 3 zone nil))
- ((string-match
- "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
- ;; Styles: (3) with timezone
- (setq year 5 month 1 day 2 time 3 zone 4))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (4) with timezone
- (setq year 3 month 2 day 1 time 4 zone 5))
- ((string-match
- "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date)
- ;; Styles: (5) without timezone.
- (setq year 3 month 2 day 1 time 4 zone nil))
- )
- (if year
- (progn
- (setq year
- (substring date (match-beginning year)
- (match-end year)))
- (if (< (length year) 4)
- (let ((yr (string-to-int year)))
- (when (>= yr 100)
- (setq yr (- yr 100)))
- (setq year (format "%d%02d"
- (if (< yr 70)
- 20
- 19)
- yr))))
- (let ((string (substring date
- (match-beginning month)
- (+ (match-beginning month) 3))))
- (setq month
- (int-to-string
- (cdr (assoc (upcase string)
- timezone-months-assoc)))))
- (setq day
- (substring date (match-beginning day) (match-end day)))
- (setq time
- (substring date (match-beginning time)
- (match-end time)))))
- (if zone
- (setq zone
- (substring date (match-beginning zone)
- (match-end zone))))
- (if year
- (vector year month day time zone)
- (vector "0" "0" "0" "0" nil))
- )
- )
- (t (signal 'invalid-date (list date))))))
-
(defsubst elmo-call-func (folder func-name &rest args)
(let* ((spec (if (stringp folder)
(elmo-folder-get-spec folder)
spec
args)))
+;; Nemacs's `read' is different.
+(static-if (fboundp 'nemacs-version)
+ (defun elmo-read (obj)
+ (prog1 (read obj)
+ (if (bufferp obj)
+ (or (bobp) (forward-char -1)))))
+ (defalias 'elmo-read 'read))
+
(defmacro elmo-set-work-buf (&rest body)
- "Execute BODY on work buffer. Work buffer remains."
+ "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)
(,@ body))))
(defmacro elmo-match-substring (pos string from)
- "Substring of POSth matched string of STRING. "
- (` (substring (, string)
+ "Substring of POSth matched string of STRING."
+ (` (substring (, string)
(+ (match-beginning (, pos)) (, from))
(match-end (, pos)))))
(defmacro elmo-match-string (pos string)
- "Substring POSth matched string."
+ "Substring POSth matched STRING."
(` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
(defmacro elmo-match-buffer (pos)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(decode-mime-charset-region (point-min) (point-max) mime-charset))
(condition-case nil
- (read (current-buffer))
+ (read (current-buffer))
(error (unless no-err
(message "Warning: Loading object from %s failed."
filename)
(if (file-writable-p filename)
(progn
(when mime-charset
- ;;(elmo-set-buffer-multibyte default-enable-multibyte-characters)
+;;; (elmo-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)))
File content is encoded with MIME-CHARSET."
(elmo-set-work-buf
(prin1 object (current-buffer))
- ;;(princ "\n" (current-buffer))
+;;;(princ "\n" (current-buffer))
(elmo-save-buffer filename mime-charset)))
(defsubst elmo-imap4-decode-folder-string (string)
(utf7-encode-string string 'imap)
string))
-(defun elmo-network-get-spec (folder default-server default-port default-tls)
- (let (server port tls)
- (if (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!*\\)$" folder)
- (progn
- (if (match-beginning 1)
- (setq server (elmo-match-substring 1 folder 1))
- (setq server default-server))
- (if (match-beginning 2)
- (setq port
- (string-to-int (elmo-match-substring 2 folder 1)))
- (setq port default-port))
- (setq tls (elmo-match-string 3 folder))
- (if (and (match-beginning 3)
- (> (length tls) 0))
- (setq tls (if (= 2 (length tls)) 'starttls
- (string= tls "!")))
- (setq tls default-tls))
- (setq folder (substring folder 0 (match-beginning 0))))
- (setq server default-server
- port default-port
- tls default-tls))
- (cons folder (list server port tls))))
+(defun elmo-get-network-stream-type (stream-type stream-type-alist)
+ (catch 'found
+ (while stream-type-alist
+ (if (eq (nth 1 (car stream-type-alist)) stream-type)
+ (throw 'found (car stream-type-alist)))
+ (setq stream-type-alist (cdr stream-type-alist)))))
+
+(defun elmo-network-get-spec (folder server port stream-type stream-type-alist)
+ (setq stream-type (elmo-get-network-stream-type
+ stream-type stream-type-alist))
+ (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" folder)
+ (if (match-beginning 1)
+ (setq server (elmo-match-substring 1 folder 1)))
+ (if (match-beginning 2)
+ (setq port (string-to-int (elmo-match-substring 2 folder 1))))
+ (if (match-beginning 3)
+ (setq stream-type (assoc (elmo-match-string 3 folder)
+ stream-type-alist)))
+ (setq folder (substring folder 0 (match-beginning 0))))
+ (cons folder (list server port stream-type)))
(defun elmo-imap4-get-spec (folder)
- (let ((default-user elmo-default-imap4-user)
- (default-server elmo-default-imap4-server)
- (default-port elmo-default-imap4-port)
- (default-tls elmo-default-imap4-ssl)
+ (let ((default-user elmo-default-imap4-user)
+ (default-server elmo-default-imap4-server)
+ (default-port elmo-default-imap4-port)
+ (default-stream-type elmo-default-imap4-stream-type)
+ (stream-type-alist elmo-network-stream-type-alist)
spec mailbox user auth)
(when (string-match "\\(.*\\)@\\(.*\\)" default-server)
- ;; case: default-imap4-server is specified like
+ ;; case: default-imap4-server is specified like
;; "hoge%imap.server@gateway".
(setq default-user (elmo-match-string 1 default-server))
(setq default-server (elmo-match-string 2 default-server)))
- (setq spec (elmo-network-get-spec
- folder default-server default-port default-tls))
+ (if elmo-imap4-stream-type-alist
+ (setq stream-type-alist
+ (append elmo-imap4-stream-type-alist stream-type-alist)))
+ (setq spec (elmo-network-get-spec
+ folder default-server default-port default-stream-type
+ stream-type-alist))
(setq folder (car spec))
(when (string-match
"^\\(%\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
folder)
(progn
- (setq mailbox (if (match-beginning 2)
+ (setq mailbox (if (match-beginning 2)
(elmo-match-string 2 folder)
elmo-default-imap4-mailbox))
(setq user (if (match-beginning 3)
(elmo-match-substring 3 folder 1)
default-user))
(setq auth (if (match-beginning 4)
- (elmo-match-substring 4 folder 1)
+ (intern (elmo-match-substring 4 folder 1))
elmo-default-imap4-authenticate-type))
- (append (list 'imap4
+ (append (list 'imap4
(elmo-imap4-encode-folder-string mailbox)
user auth)
(cdr spec))))))
(defsubst elmo-imap4-spec-port (spec)
(nth 5 spec))
-(defsubst elmo-imap4-spec-ssl (spec)
+(defsubst elmo-imap4-spec-stream-type (spec)
(nth 6 spec))
-(defsubst elmo-imap4-spec-folder (spec) ;; obsolete
- (nth 1 spec))
+(defalias 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox)
+(make-obsolete 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox)
(defsubst elmo-imap4-connection-get-process (conn)
(nth 1 conn))
(nth 2 conn))
(defun elmo-nntp-get-spec (folder)
- (let (spec group user)
+ (let ((stream-type-alist elmo-network-stream-type-alist)
+ spec group user)
+ (if elmo-nntp-stream-type-alist
+ (setq stream-type-alist
+ (append elmo-nntp-stream-type-alist stream-type-alist)))
(setq spec (elmo-network-get-spec folder
elmo-default-nntp-server
elmo-default-nntp-port
- elmo-default-nntp-ssl))
+ elmo-default-nntp-stream-type
+ stream-type-alist))
(setq folder (car spec))
(when (string-match
"^\\(-\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
folder)
- (setq group
+ (setq group
(if (match-beginning 2)
(elmo-match-string 2 folder)))
- (setq user
- (if (match-beginning 3)
+ (setq user
+ (if (match-beginning 3)
(elmo-match-substring 3 folder 1)
elmo-default-nntp-user))
(append (list 'nntp group user)
(defsubst elmo-nntp-spec-group (spec)
(nth 1 spec))
-(defsubst elmo-nntp-spec-username (spec)
+(defsubst elmo-nntp-spec-username (spec)
(nth 2 spec))
;; future use?
(defsubst elmo-nntp-spec-port (spec)
(nth 4 spec))
-(defsubst elmo-nntp-spec-ssl (spec)
+(defsubst elmo-nntp-spec-stream-type (spec)
(nth 5 spec))
(defun elmo-localdir-get-spec (folder)
)
(if (file-name-absolute-p fld-name)
(setq path (expand-file-name fld-name))
+;;; (setq path (expand-file-name fld-name
+;;; elmo-localdir-folder-path))
(setq path fld-name))
- ;(setq path (expand-file-name fld-name
- ;elmo-localdir-folder-path)))
(list (if (elmo-folder-maildir-p folder)
'maildir
'localdir) path))))
(elmo-match-string 2 folder))) 0)
(setq fld-name "")
)
- (list 'localnews
+ (list 'localnews
(elmo-replace-in-string fld-name "\\." "/")))))
(defun elmo-cache-get-spec (folder)
(list 'archive fld-name (intern-soft type) prefix))))
(defun elmo-pop3-get-spec (folder)
- (let (spec user auth)
+ (let ((stream-type-alist elmo-network-stream-type-alist)
+ spec user auth)
+ (if elmo-pop3-stream-type-alist
+ (setq stream-type-alist
+ (append elmo-pop3-stream-type-alist stream-type-alist)))
(setq spec (elmo-network-get-spec folder
elmo-default-pop3-server
elmo-default-pop3-port
- elmo-default-pop3-ssl))
+ elmo-default-pop3-stream-type
+ stream-type-alist))
(setq folder (car spec))
(when (string-match
"^\\(&\\)\\([^:/!]*\\)\\(/[^/:@!]+\\)?"
(if (eq (length user) 0)
(setq user elmo-default-pop3-user))
(setq auth (if (match-beginning 3)
- (elmo-match-substring 3 folder 1)
+ (intern (elmo-match-substring 3 folder 1))
elmo-default-pop3-authenticate-type))
(append (list 'pop3 user auth)
(cdr spec)))))
(defsubst elmo-pop3-spec-port (spec)
(nth 4 spec))
-(defsubst elmo-pop3-spec-ssl (spec)
+(defsubst elmo-pop3-spec-stream-type (spec)
(nth 5 spec))
(defun elmo-internal-get-spec (folder)
",")))))
(defun elmo-filter-get-spec (folder)
- (save-match-data
- (when (string-match
- "^\\(/\\)\\(.*\\)$"
- folder)
- (let ((spec (elmo-match-string 2 folder))
- filter)
- (when (string-match "\\([^/]+\\)/" spec)
- (setq filter (elmo-match-string 1 spec))
- (setq spec (substring spec (match-end 0))))
- (cond
- ((string-match "^\\(last\\|first\\):\\(.*\\)$" filter) ; partial
- (setq filter (vector 'partial
- (elmo-match-string 1 filter)
- (elmo-match-string 2 filter))))
- (t
- (setq filter (elmo-parse-search-condition filter))))
- (list 'filter filter spec)))))
+ (when (string-match "^\\(/\\)\\(.*\\)$" folder)
+ (let ((folder (elmo-match-string 2 folder))
+ pair)
+ (setq pair (elmo-parse-search-condition folder))
+ (if (string-match "^ */\\(.*\\)$" (cdr pair))
+ (list 'filter (car pair) (elmo-match-string 1 (cdr pair)))
+ (error "Folder syntax error `%s'" folder)))))
(defun elmo-pipe-get-spec (folder)
(when (string-match "^\\(|\\)\\([^|]*\\)|\\(.*\\)$" folder)
(elmo-match-string 3 folder))))
(defun elmo-folder-get-spec (folder)
- "return spec of folder"
+ "Return spec of FOLDER."
(let ((type (elmo-folder-get-type folder)))
(if type
- (funcall (intern (concat "elmo-" (symbol-name type) "-get-spec"))
- folder)
+ (save-match-data
+ (funcall (intern (concat "elmo-" (symbol-name type) "-get-spec"))
+ folder))
(error "%s is not supported folder type" folder))))
-(defun elmo-parse-search-condition (condition)
- (let ((terms (split-string condition "|")) ; split by OR
- term ret-val)
- (while terms
- (setq term (car terms))
- (cond
- ((string-match "^\\([a-zA-Z\\-]+\\)=\\(.*\\)$" term)
- (if (save-match-data
- (string-match "tocc" (elmo-match-string 1 term))) ;; syntax sugar
- (setq ret-val (nconc
- ret-val
- (list (vector 'match "to"
- (elmo-match-string 2 term))
- (vector 'match "cc"
- (elmo-match-string 2 term)))))
- (setq ret-val (cons (vector 'match
- (elmo-match-string 1 term)
- (elmo-match-string 2 term))
- ret-val))))
- ((string-match "^\\([a-zA-Z\\-]+\\)!=\\(.*\\)$" term)
- (if (save-match-data
- (string-match "tocc" (elmo-match-string 1 term))) ;; syntax sugar
- (setq ret-val (nconc
- ret-val
- (list (vector 'unmatch "to"
- (elmo-match-string 2 term))
- (vector 'unmatch "cc"
- (elmo-match-string 2 term)))))
- (setq ret-val (cons (vector 'unmatch
- (elmo-match-string 1 term)
- (elmo-match-string 2 term))
- ret-val))))
- ((string-match "^\\(since\\|before\\):\\(.*\\)$" term)
- (setq ret-val (cons (vector 'date
- (elmo-match-string 1 term)
- (elmo-match-string 2 term))
- ret-val))))
- (setq terms (cdr terms)))
- ret-val))
+;;; 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"
+ "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)
+ (concat (downcase field) ":"
+ (completing-read (format "Value for '%s': " field)
+ (mapcar (function
+ (lambda (x)
+ (list (format "%s" (car x)))))
+ elmo-date-descriptions))))
+ (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)))
+(defun elmo-parse-search-condition (condition)
+ "Parse CONDITION.
+Return value is a cons cell of (STRUCTURE . REST)"
+ (with-temp-buffer
+ (insert condition)
+ (goto-char (point-min))
+ (cons (elmo-condition-parse) (buffer-substring (point) (point-max)))))
+
+;; condition ::= or-expr
+(defun elmo-condition-parse ()
+ (or (elmo-condition-parse-or-expr)
+ (elmo-condition-parse-error)))
+
+;; or-expr ::= and-expr /
+;; and-expr "|" or-expr
+(defun elmo-condition-parse-or-expr ()
+ (let ((left (elmo-condition-parse-and-expr)))
+ (if (looking-at "| *")
+ (progn
+ (goto-char (match-end 0))
+ (list 'or left (elmo-condition-parse-or-expr)))
+ left)))
+
+;; and-expr ::= primitive /
+;; primitive "&" and-expr
+(defun elmo-condition-parse-and-expr ()
+ (let ((left (elmo-condition-parse-primitive)))
+ (if (looking-at "& *")
+ (progn
+ (goto-char (match-end 0))
+ (list 'and left (elmo-condition-parse-and-expr)))
+ left)))
+
+;; primitive ::= "(" expr ")" /
+;; ["!"] search-key SPACE* ":" SPACE* search-value
+(defun elmo-condition-parse-primitive ()
+ (cond
+ ((looking-at "( *")
+ (goto-char (match-end 0))
+ (prog1 (elmo-condition-parse)
+ (unless (looking-at ") *")
+ (elmo-condition-parse-error))
+ (goto-char (match-end 0))))
+;; search-key ::= [A-Za-z-]+
+;; ;; "since" / "before" / "last" / "first" /
+;; ;; "body" / 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)
+ (elmo-condition-parse-search-value))))
+ ;; syntax sugar.
+ (if (string= (aref search-key 1) "tocc")
+ (if (eq (aref search-key 0) 'match)
+ (list 'or
+ (vector 'match "to" (aref search-key 2))
+ (vector 'match "cc" (aref search-key 2)))
+ (list 'and
+ (vector 'unmatch "to" (aref search-key 2))
+ (vector 'unmatch "cc" (aref search-key 2))))
+ search-key)))))
+
+;; search-value ::= quoted / time / number / atom
+;; quoted ::= <elisp string expression>
+;; time ::= "yesterday" / "lastweek" / "lastmonth" / "lastyear" /
+;; number SPACE* "daysago" /
+;; number "-" month "-" number ; ex. 10-May-2000
+;; number ::= [0-9]+
+;; month ::= "Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" /
+;; "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec"
+;; atom ::= ATOM_CHARS*
+;; SPACE ::= <ascii space character, 0x20>
+;; ATOM_CHARS ::= <any character except specials>
+;; specials ::= SPACE / <"> / </> / <)> / <|> / <&>
+;; ;; These characters should be quoted.
+(defun elmo-condition-parse-search-value ()
+ (cond
+ ((looking-at "\"")
+ (elmo-read (current-buffer)))
+ ((or (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]+")
+ (looking-at elmo-condition-atom-regexp))
+ (prog1 (elmo-match-buffer 0)
+ (goto-char (match-end 0))))
+ (t (error "Syntax error '%s'" (buffer-string)))))
+
+;;;
(defun elmo-multi-get-real-folder-number (folder number)
(let* ((spec (elmo-folder-get-spec folder))
(flds (cdr spec))
(defun elmo-uniq-list (lst)
"Distractively uniqfy elements of LST."
(let ((tmp lst))
- (while tmp (setq tmp (setcdr tmp (and (cdr tmp) (delete (car tmp) (cdr tmp)))))))
+ (while tmp (setq tmp
+ (setcdr tmp
+ (and (cdr tmp)
+ (delete (car tmp)
+ (cdr tmp)))))))
lst)
(defun elmo-string-partial-p (string)
(elmo-set-work-buf
(as-binary-output-file
(insert string)
- (write-region (point-min) (point-max)
+ (write-region (point-min) (point-max)
filename nil 'no-msg))
)))
(defun elmo-max-of-list (nlist)
- (let ((l nlist)
+ (let ((l nlist)
(max-num 0))
(while l
(if (< max-num (car l))
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
+ insert-file-contents-post-hook
ret-val)
(if (not (file-readable-p filename))
()
(insert-file-contents filename)
(setq ret-val
(condition-case nil
- (read (current-buffer))
+ (read (current-buffer))
(error nil nil))))
(kill-buffer tmp-buffer)
ret-val)))
+(defun elmo-passwd-alist-clear ()
+ "Clear password cache."
+ (interactive)
+ (setq elmo-passwd-alist nil))
+
(defun elmo-passwd-alist-save ()
"Save password into file."
(interactive)
(erase-buffer)
(prin1 elmo-passwd-alist tmp-buffer)
(princ "\n" tmp-buffer)
-; (if (and (file-exists-p filename)
-; (not (equal 384 (file-modes filename))))
-; (error "%s is not safe.chmod 600 %s!" filename filename))
+;;; (if (and (file-exists-p filename)
+;;; (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)
+ (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 (user-at-host)
+(defun elmo-get-passwd (key)
"Get password from password pool."
- (let (data pass)
+ (let (pair pass)
(if (not elmo-passwd-alist)
(setq elmo-passwd-alist (elmo-passwd-alist-load)))
- (setq data (assoc user-at-host elmo-passwd-alist))
- (if data
- (elmo-base64-decode-string (cdr data))
- (setq pass (elmo-read-passwd (format "Password for %s: "
- user-at-host) t))
+ (setq pair (assoc key elmo-passwd-alist))
+ (if pair
+ (elmo-base64-decode-string (cdr pair))
+ (setq pass (elmo-read-passwd (format "Password for %s: "
+ key) t))
(setq elmo-passwd-alist
(append elmo-passwd-alist
- (list (cons user-at-host
+ (list (cons key
(elmo-base64-encode-string pass)))))
+ (if elmo-passwd-life-time
+ (run-with-timer elmo-passwd-life-time nil
+ (` (lambda () (elmo-remove-passwd (, key))))))
pass)))
-(defun elmo-remove-passwd (user-at-host)
+(defun elmo-remove-passwd (key)
"Remove password from password pool (for failure)."
- (setq elmo-passwd-alist
- (delete (assoc user-at-host elmo-passwd-alist)
- elmo-passwd-alist
- )))
+ (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))))))
(defmacro elmo-read-char-exclusive ()
(cond ((featurep 'xemacs)
;; from subr.el
(defun elmo-replace-in-string (str regexp newtext &optional literal)
- "Replaces all matches in STR for REGEXP with NEWTEXT string,
- and returns the new string.
+ "Replace all matches in STR for REGEXP with NEWTEXT string.
+And returns the new string.
Optional LITERAL non-nil means do a literal replacement.
Otherwise treat \\ in NEWTEXT string as special:
\\& means substitute original matched text,
start (match-end 0)
rtn-str
(concat
- rtn-str
- (substring str prev-start match)
- (cond (literal newtext)
- (t (mapconcat
- (function
- (lambda (c)
- (if special
- (progn
- (setq special nil)
- (cond ((eq c ?\\) "\\")
- ((eq c ?&)
- (elmo-match-string 0 str))
- ((and (>= c ?0) (<= c ?9))
- (if (> c (+ ?0 (length
- (match-data))))
- ; Invalid match num
- (error "Invalid match num: %c" c)
- (setq c (- c ?0))
- (elmo-match-string c str)))
- (t (char-to-string c))))
- (if (eq c ?\\) (progn (setq special t) nil)
- (char-to-string c)))))
- newtext ""))))))
+ rtn-str
+ (substring str prev-start match)
+ (cond (literal newtext)
+ (t (mapconcat
+ (function
+ (lambda (c)
+ (if special
+ (progn
+ (setq special nil)
+ (cond ((eq c ?\\) "\\")
+ ((eq c ?&)
+ (elmo-match-string 0 str))
+ ((and (>= c ?0) (<= c ?9))
+ (if (> c (+ ?0 (length
+ (match-data))))
+ ;; Invalid match num
+ (error "Invalid match num: %c" c)
+ (setq c (- c ?0))
+ (elmo-match-string c str)))
+ (t (char-to-string c))))
+ (if (eq c ?\\) (progn (setq special t) nil)
+ (char-to-string c)))))
+ newtext ""))))))
(concat rtn-str (substring str start))))
(defun elmo-string-to-list (string)
(defun elmo-delete-plugged (&optional server port alist)
(let* ((alist (or alist elmo-plugged-alist))
(alist2 alist))
- (cond ((and (not port) (not server))
+ (cond ((and (not port) (not server))
(setq alist nil))
((not port)
;; delete plugged all port of server
(t
;; delete plugged one port of server
(setq alist
- (delete (assoc (cons server port) alist)) alist)))
+ (delete (assoc (cons server port) alist) alist))))
alist))
(defun elmo-disk-usage (path)
"Get disk usage (bytes) in PATH."
- (let ((file-attr
+ (let ((file-attr
(condition-case () (file-attributes path) (error nil))))
(if file-attr
(if (nth 0 file-attr) ; directory
- (let ((files (condition-case ()
+ (let ((files (condition-case ()
(directory-files path t "^[^\\.]")
(error nil)))
(result 0.0))
(float (nth 7 file-attr))))))
(defun elmo-get-last-accessed-time (path &optional dir)
- "Returns last accessed time."
+ "Return the last accessed time of PATH."
(let ((last-accessed (nth 4 (file-attributes (or (and dir
(expand-file-name
path dir))
0)))
(defun elmo-get-last-modification-time (path &optional dir)
- "Returns last accessed time."
+ "Return the last accessed time of PATH."
(let ((last-modified (nth 5 (file-attributes (or (and dir
(expand-file-name
path dir))
(float 65536)) (nth 1 last-modified)))))
(defun elmo-make-directory (path)
- "create directory recursively."
+ "Create directory recursively."
(let ((parent (directory-file-name (file-name-directory path))))
(if (null (file-directory-p parent))
(elmo-make-directory parent))
(make-directory path)
(if (string= path (expand-file-name elmo-msgdb-dir))
- (set-file-modes path 448) ; 700
- )))
+ (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
(defun elmo-delete-directory (path &optional no-hierarchy)
- "delete directory recursively."
+ "Delete directory recursively."
(let ((dirent (directory-files path))
relpath abspath hierarchy)
(while dirent
(while numbers
(setq cur-number (+ cur-number 1))
(setq one-list nil)
- (while (and numbers
+ (while (and numbers
(eq 0
(/ (- (car numbers)
(* elmo-multi-divide-number cur-number))
elmo-multi-divide-number)))
(setq one-list (nconc
- one-list
- (list
+ one-list
+ (list
(if as-is
(car numbers)
(% (car numbers)
ret-val))
(defun elmo-list-diff (list1 list2 &optional mes)
- (if mes
+ (if mes
(message mes))
(let ((clist1 (copy-sequence list1))
(clist2 (copy-sequence list2)))
(list clist1 clist2)))
(defun elmo-list-bigger-diff (list1 list2 &optional mes)
- "Returns a list (- +). + is bigger than max of LIST1, in LIST2"
+ "Returns a list (- +). + is bigger than max of LIST1, in LIST2."
(if (null list2)
(cons list1 nil)
(let* ((l1 list1)
result
dels news)
(while (or list1-list list2-list)
- (setq result (elmo-list-bigger-diff (car list1-list) (car list2-list)
+ (setq result (elmo-list-bigger-diff (car list1-list) (car list2-list)
mes))
(setq dels (append dels (car result)))
(setq news (append news (cadr result)))
t))
(defun elmo-folder-identical-system-p (folder1 folder2)
- "folder1 and folder2 should be real folder (not virtual)."
+ "FOLDER1 and FOLDER2 should be real folder (not virtual)."
(cond ((eq (elmo-folder-get-type folder1) 'imap4)
(let ((spec1 (elmo-folder-get-spec folder1))
(spec2 (elmo-folder-get-spec folder2)))
- (and (elmo-imap4-identical-name-space-p
- (nth 1 spec1) (nth 1 spec2))
- (string= (elmo-imap4-spec-hostname spec1)
- (elmo-imap4-spec-hostname spec2)) ; hostname
- (string= (elmo-imap4-spec-username spec1)
- (elmo-imap4-spec-username spec2))))) ; username
+ (and
+;;; No use.
+;;; (elmo-imap4-identical-name-space-p
+;;; (nth 1 spec1) (nth 1 spec2))
+ (string= (elmo-imap4-spec-hostname spec1)
+ (elmo-imap4-spec-hostname spec2)) ; hostname
+ (string= (elmo-imap4-spec-username spec1)
+ (elmo-imap4-spec-username spec2))))) ; username
(t
(elmo-folder-direct-copy-p folder1 folder2))))
(defmacro elmo-filter-value (filter)
(` (aref (, filter) 2)))
-(defsubst elmo-buffer-field-condition-match (condition)
- (let (term)
- (catch 'done
- (while condition
- (goto-char (point-min))
- (setq term (car condition))
- (cond
- ((and (eq (elmo-filter-type term) 'date)
- (string= (elmo-filter-key term) "since"))
- (let ((date (elmo-date-get-datevec (elmo-filter-value term))))
- (if (string<
- (timezone-make-sortable-date (aref date 0)
- (aref date 1)
- (aref date 2)
- (timezone-make-time-string
- (aref date 3)
- (aref date 4)
- (aref date 5)))
- (timezone-make-date-sortable (std11-field-body "date")))
- (throw 'done t))))
- ((and (eq (elmo-filter-type term) 'date)
- (string= (elmo-filter-key term) "before"))
- (let ((date (elmo-date-get-datevec (elmo-filter-value term))))
- (if (string<
- (timezone-make-date-sortable (std11-field-body "date"))
- (timezone-make-sortable-date (aref date 0)
- (aref date 1)
- (aref date 2)
- (timezone-make-time-string
- (aref date 3)
- (aref date 4)
- (aref date 5))))
- (throw 'done t))))
- ((eq (elmo-filter-type term) 'match)
- (if (string= "body" (elmo-filter-key term))
- (progn
- (re-search-forward "^$" nil t) ; goto body
- (if (search-forward (elmo-filter-value term) nil t)
- (throw 'done t)))
- (let ((fval (eword-decode-string
- (or (std11-field-body (elmo-filter-key term)) ""))))
- (if (and fval (string-match (elmo-filter-value term)
- fval))
- (throw 'done t)))))
- ((eq (elmo-filter-type term) 'unmatch)
- (if (string= "body" (elmo-filter-key term))
- (progn
- (re-search-forward "^$" nil t) ; goto body
- (if (not (search-forward (elmo-filter-value term) nil t))
- (throw 'done t)))
- (let ((fval (eword-decode-string
- (or (std11-field-body (elmo-filter-key term)) ""))))
- (if fval
- (if (not (string-match (elmo-filter-value term)
- fval))
- (throw 'done t))
- (throw 'done t)))))) ; OK?
- (setq condition (cdr condition)))
- (throw 'done nil))))
-
-(defsubst elmo-file-field-condition-match (file condition)
+(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 ((date (elmo-date-get-datevec (elmo-filter-value condition))))
+ (setq result
+ (string<
+ (timezone-make-sortable-date (aref date 0)
+ (aref date 1)
+ (aref date 2)
+ (timezone-make-time-string
+ (aref date 3)
+ (aref date 4)
+ (aref date 5)))
+ (timezone-make-date-sortable (std11-field-body "date"))))))
+ ((string= (elmo-filter-key condition) "before")
+ (let ((date (elmo-date-get-datevec (elmo-filter-value condition))))
+ (setq result
+ (string<
+ (timezone-make-date-sortable (std11-field-body "date"))
+ (timezone-make-sortable-date (aref date 0)
+ (aref date 1)
+ (aref date 2)
+ (timezone-make-time-string
+ (aref date 3)
+ (aref date 4)
+ (aref date 5)))))))
+ ((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
+ (let ((fval (std11-field-body (elmo-filter-key condition))))
+ (if (eq (length fval) 0) (setq fval nil))
+ (if fval (setq fval (eword-decode-string fval)))
+ (setq 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-find-key-internal (condition key)
+ (cond
+ ((vectorp condition)
+ (if (string= (elmo-filter-key condition) key)
+ (throw 'found t)))
+ ((or (eq (car condition) 'and)
+ (eq (car condition) 'or))
+ (elmo-condition-find-key-internal (nth 1 condition) key)
+ (elmo-condition-find-key-internal (nth 2 condition) key))))
+
+(defun elmo-condition-find-key (condition key)
+ (catch 'found
+ (elmo-condition-find-key-internal condition key)))
+
+(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-condition-match (file condition number number-list)
(elmo-set-work-buf
- (as-binary-input-file
- (insert-file-contents file))
+ (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)
- (elmo-buffer-field-condition-match condition)))
-
-(defun elmo-cross-device-link-error-p (err)
- (let ((errobj err)
- cur)
- (catch 'done
- (while errobj
- (if (and (stringp (setq cur (car errobj)))
- (or (string-match "cross-device" cur)
- (string-match "operation not supported" cur)))
- (throw 'done t))
- (setq errobj (cdr errobj)))
- nil)))
+ (elmo-buffer-field-condition-match condition number number-list)))
(defmacro elmo-get-hash-val (string hashtable)
(let ((sym (list 'intern-soft string hashtable)))
(defmacro elmo-set-hash-val (string value hashtable)
(list 'set (list 'intern string hashtable) value))
+(defmacro elmo-clear-hash-val (string hashtable)
+ (static-if (fboundp 'unintern)
+ (list 'unintern string hashtable)
+ (list 'makunbound (list 'intern string hashtable))))
+
+(defmacro elmo-unintern (string)
+ "`unintern' symbol named STRING, When can use `unintern'.
+Emacs 19.28 or earlier does not have `unintern'."
+ (static-if (fboundp 'unintern)
+ (list 'unintern string)))
+
;; Make a hash table (default and minimum size is 1024).
(defun elmo-make-hash (&optional hashsize)
- (make-vector (if hashsize (max (elmo-create-hash-size hashsize) 1024) 1024) 0))
+ (make-vector
+ (if hashsize (max (min (elmo-create-hash-size hashsize)
+ elmo-hash-maximum-size) 1024) 1024) 0))
(defsubst elmo-mime-string (string)
- "Normalize MIME encoded string."
+ "Normalize MIME encoded STRING."
(and string
(let (str)
(elmo-set-work-buf
(defvar elmo-msgid-replace-chars nil)
(defsubst elmo-replace-msgid-as-filename (msgid)
- "Replace message-id string as filename."
+ "Replace Message-ID string (MSGID) as filename."
(setq msgid (elmo-replace-in-string msgid " " " "))
(if (null elmo-msgid-replace-chars)
- (setq elmo-msgid-replace-chars
- (regexp-quote (mapconcat
+ (setq elmo-msgid-replace-chars
+ (regexp-quote (mapconcat
'car elmo-msgid-replace-string-alist ""))))
(while (string-match (concat "[" elmo-msgid-replace-chars "]")
msgid)
- (setq msgid (concat
+ (setq msgid (concat
(substring msgid 0 (match-beginning 0))
- (cdr (assoc
- (substring msgid
+ (cdr (assoc
+ (substring msgid
(match-beginning 0) (match-end 0))
elmo-msgid-replace-string-alist))
(substring msgid (match-end 0)))))
msgid)
(defsubst elmo-recover-msgid-from-filename (filename)
- "Recover Message-ID from filename."
+ "Recover Message-ID from FILENAME."
(let (tmp result)
(while (string-match " " filename)
- (setq tmp (substring filename
+ (setq tmp (substring filename
(match-beginning 0)
(+ (match-end 0) 1)))
(if (string= tmp " ")
(setq tmp " ")
- (setq tmp (car (rassoc tmp
+ (setq tmp (car (rassoc tmp
elmo-msgid-replace-string-alist))))
(setq result
- (concat result
+ (concat result
(substring filename 0 (match-beginning 0))
tmp))
(setq filename (substring filename (+ (match-end 0) 1))))
(defsubst elmo-copy-file (src dst)
(condition-case err
(elmo-add-name-to-file src dst t)
- (error (if (elmo-cross-device-link-error-p err)
- (copy-file src dst t)
- (error "copy file failed")))))
-
-(defmacro elmo-buffer-exists-p (buffer)
- (` (when (, buffer)
- (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name)
- (, buffer)))))
-
-(defmacro elmo-kill-buffer (buffer)
- (` (when (elmo-buffer-exists-p (, buffer))
- (kill-buffer (, buffer)))))
-
-(defun elmo-delete-lists (keys list)
- "Delete all entries in LIST that equal to KEYS."
- (while keys
- (setq list (delete (car keys) list))
- (setq keys (cdr keys)))
- list)
+ (error (copy-file src dst t))))
+
+(defsubst elmo-buffer-exists-p (buffer)
+ (if (bufferp buffer)
+ (buffer-live-p buffer)
+ (get-buffer buffer)))
+
+(defsubst elmo-kill-buffer (buffer)
+ (when (elmo-buffer-exists-p buffer)
+ (kill-buffer buffer)))
(defun elmo-delete-if (pred lst)
- "Returns new list contains items which don't satisfy PRED in LST."
+ "Return new list contain items which don't satisfy PRED in LST."
(let (result)
(while lst
(unless (funcall pred (car lst))
result))
(defun elmo-list-delete (list1 list2)
- "Any element of list1 is deleted from list2."
+ "Delete by side effect any occurrences equal to elements of LIST1 from LIST2.
+Return the modified LIST2. Deletion is done with `delete'.
+Write `(setq foo (elmo-list-delete bar foo))' to be sure of changing
+the value of `foo'."
(while list1
(setq list2 (delete (car list1) list2))
- (setq list1 (cdr list1)))
+ (setq list1 (cdr list1)))
list2)
(defun elmo-list-member (list1 list2)
- "If any element of list1 is member of list2, returns t."
+ "If any element of LIST1 is member of LIST2, return t."
(catch 'done
(while list1
(if (member (car list1) list2)
(if (fboundp 'display-error)
(defalias 'elmo-display-error 'display-error)
(defun elmo-display-error (error-object stream)
- "a tiny function to display error-object to the stream."
+ "A tiny function to display ERROR-OBJECT to the STREAM."
(let ((first t)
(errobj error-object)
err-mes)
(while errobj
- (setq err-mes (concat err-mes (format
+ (setq err-mes (concat err-mes (format
(if (stringp (car errobj))
"%s"
(if (boundp 'nemacs-version)
(setq first nil))
(princ err-mes stream))))
-(if (fboundp 'lprogress-display)
- (defalias 'elmo-display-progress 'lprogress-display)
- (defun elmo-display-progress (label format &optional value &rest args)
- "Print a progress message."
- (if (and (null format) (null args))
- (message nil)
- (apply (function message) (concat format " %d%%")
- (nconc args (list value))))))
+(if (fboundp 'define-error)
+ (defalias 'elmo-define-error 'define-error)
+ (defun elmo-define-error (error doc &optional parents)
+ (or parents
+ (setq parents 'error))
+ (let ((conds (get parents 'error-conditions)))
+ (or conds
+ (error "Not an error symbol: %s" error))
+ (setplist error
+ (list 'error-message doc
+ 'error-conditions (cons error conds))))))
+
+(cond ((fboundp 'lprogress-display)
+ (defalias 'elmo-display-progress 'lprogress-display))
+ ((fboundp 'progress-feedback-with-label)
+ (defalias 'elmo-display-progress 'progress-feedback-with-label))
+ (t
+ (defun elmo-display-progress (label format &optional value &rest args)
+ "Print a progress message."
+ (if (and (null format) (null args))
+ (message nil)
+ (apply (function message) (concat format " %d%%")
+ (nconc args (list value)))))))
(defun elmo-time-expire (before-time diff-time)
(let* ((current (current-time))
(and (eq (car diff) 0)
(< diff-time (nth 1 diff)))))
-(defun elmo-open-network-stream (name buffer host service ssl)
- (let ((auto-plugged (and elmo-auto-change-plugged
- (> elmo-auto-change-plugged 0)))
- process)
- (if (eq ssl 'starttls)
- (require 'starttls)
- (if ssl (require 'ssl)))
- (condition-case err
- (let (process-connection-type)
- (setq process
- (if (eq ssl 'starttls)
- (starttls-open-stream name buffer host service)
- (if ssl
- (open-ssl-stream name buffer host service)
- (open-network-stream name buffer host service)))))
- (error
- (when auto-plugged
- (elmo-set-plugged nil host service (current-time))
- (message "Auto plugged off at %s:%d" host service)
- (sit-for 1))
- (signal (car err) (cdr err))))
- (when process
- (process-kill-without-query process)
- (when auto-plugged
- (elmo-set-plugged t host service))
- process)))
-
(if (fboundp 'std11-fetch-field)
(defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
(defalias 'elmo-field-body 'std11-field-body))
(defmacro elmo-string (string)
- "String without text property"
+ "STRING without text property."
(` (let ((obj (copy-sequence (, string))))
(set-text-properties 0 (length obj) nil obj)
obj)))
+(defun elmo-flatten (list-of-list)
+ "Flatten LIST-OF-LIST."
+ (unless (null list-of-list)
+ (append (if (and (car list-of-list)
+ (listp (car list-of-list)))
+ (car list-of-list)
+ (list (car list-of-list)))
+ (elmo-flatten (cdr list-of-list)))))
+
(defun elmo-y-or-n-p (prompt &optional auto default)
"Same as `y-or-n-p'.
But if optional argument AUTO is non-nil, DEFAULT is returned."
(y-or-n-p prompt)))
(defun elmo-string-member (string slist)
- "Returns t if STRING is a member of the SLIST."
+ "Return t if STRING is a member of the SLIST."
(catch 'found
(while slist
(if (and (stringp (car slist))
(throw 'member (car list)))
(setq list (cdr list))))))
+(defun elmo-string-matched-member (str list &optional case-ignore)
+ (let ((case-fold-search case-ignore))
+ (catch 'member
+ (while list
+ (if (string-match str (car list))
+ (throw 'member (car list)))
+ (setq list (cdr list))))))
+
(defsubst elmo-string-delete-match (string pos)
(concat (substring string
0 (match-beginning pos))
(throw 'loop a))
(setq alist (cdr alist))))))
-(provide 'elmo-util)
+;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
+;;
+;; number ::= [0-9]+
+;; beg ::= number
+;; end ::= number
+;; number-range ::= "(" beg " . " end ")" ;; cons cell
+;; number-set-elem ::= number / number-range
+;; number-set ::= "(" *number-set-elem ")" ;; list
+
+(defun elmo-number-set-member (number number-set)
+ "Return non-nil if NUMBER is an element of NUMBER-SET.
+The value is actually the tail of NUMBER-RANGE whose car contains NUMBER."
+ (or (memq number number-set)
+ (let (found)
+ (while (and number-set (not found))
+ (if (and (consp (car number-set))
+ (and (<= (car (car number-set)) number)
+ (<= number (cdr (car number-set)))))
+ (setq found t)
+ (setq number-set (cdr number-set))))
+ number-set)))
+
+(defun elmo-number-set-append-list (number-set list)
+ "Append LIST of numbers to the NUMBER-SET.
+NUMBER-SET is altered."
+ (let ((appended number-set))
+ (while list
+ (setq appended (elmo-number-set-append appended (car list)))
+ (setq list (cdr list)))
+ appended))
+
+(defun elmo-number-set-append (number-set number)
+ "Append NUMBER to the NUMBER-SET.
+NUMBER-SET is altered."
+ (let ((number-set-1 number-set)
+ found elem)
+ (while (and number-set (not found))
+ (setq elem (car number-set))
+ (cond
+ ((and (consp elem)
+ (eq (+ 1 (cdr elem)) number))
+ (setcdr elem number)
+ (setq found t))
+ ((and (integerp elem)
+ (eq (+ 1 elem) number))
+ (setcar number-set (cons elem number))
+ (setq found t))
+ ((or (and (integerp elem) (eq elem number))
+ (and (consp elem)
+ (<= (car elem) number)
+ (<= number (cdr elem))))
+ (setq found t)))
+ (setq number-set (cdr number-set)))
+ (if (not found)
+ (setq number-set-1 (nconc number-set-1 (list number))))
+ number-set-1))
+
+(require 'product)
+(product-provide (provide 'elmo-util) (require 'elmo-version))
;;; elmo-util.el ends here