(elmo-collect-separators-internal): Ditto.
(elmo-collect-trail-separators): Ditto.
(elmo-parse-separated-tokens): Ditto.
(elmo-parse-separated-tokens-internal): Ditto.
(elmo-quote-syntactical-element): Ditto.
* elmo-pop3.el (elmo-pop3-folder-name-syntax): New constant.
(elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
* elmo-nntp.el (elmo-nntp-folder-name-syntax): New constant.
(elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
(elmo-nntp-folder-list-subfolders): Quote a user name.
* elmo-net.el (elmo-net-folder-name-syntax): New constant.
(elmo-net-parse-network): Abolish.
(elmo-net-folder-set-parameters): New function.
(elmo-folder-initialize): Follow the above change.
* elmo-imap4.el (elmo-imap4-folder-name-syntax): New constant.
(elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
(elmo-folder-list-subfolders): Use
`elmo-quote-syntactical-element' instead of
`elmo-net-format-quoted' to quote mailbox and user name.
@example
@group
-@samp{-} @var{\e$B%K%e!<%9%0%k!<%WL>\e(B} [[@samp{:} @var{\e$B%f!<%6L>\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}]][@samp{!}]
+@samp{-} @var{\e$B%K%e!<%9%0%k!<%WL>\e(B} [@samp{:} @var{\e$B%f!<%6L>\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}][@samp{!}]
@end group
@end example
@example
@group
-@samp{&} [@var{\e$B%f!<%6L>\e(B}][[@samp{/} @var{\e$BG'>ZK!\e(B}][@samp{:} @var{\e$BHV9f$N?6$jJ}\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}]][@samp{!}]
+@samp{&} [@var{\e$B%f!<%6L>\e(B}][@samp{/} @var{\e$BG'>ZK!\e(B}][@samp{:} @var{\e$BHV9f$N?6$jJ}\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}][@samp{!}]
@end group
@end example
@example
@group
-@samp{-} @var{newsgroup} [[@samp{:} @var{username}][@samp{@@} @var{hostname}][@samp{:} @var{port}]][@samp{!}]
+@samp{-} @var{newsgroup} [@samp{:} @var{username}][@samp{@@} @var{hostname}][@samp{:} @var{port}][@samp{!}]
@end group
@end example
@example
@group
-@samp{&} [@var{username}][[@samp{/} @var{authenticate-type}][@samp{:} @var{numbering-method}][@samp{@@} @var{hostname}][@samp{:} @var{port}]][@samp{!}]
+@samp{&} [@var{username}][@samp{/} @var{authenticate-type}][@samp{:} @var{numbering-method}][@samp{@@} @var{hostname}][@samp{:} @var{port}][@samp{!}]
@end group
@end example
+2005-06-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-collect-separators): New function.
+ (elmo-collect-separators-internal): Ditto.
+ (elmo-collect-trail-separators): Ditto.
+ (elmo-parse-separated-tokens): Ditto.
+ (elmo-parse-separated-tokens-internal): Ditto.
+ (elmo-quote-syntactical-element): Ditto.
+
+ * elmo-pop3.el (elmo-pop3-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+
+ * elmo-nntp.el (elmo-nntp-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+ (elmo-nntp-folder-list-subfolders): Quote a user name.
+
+ * elmo-net.el (elmo-net-folder-name-syntax): New constant.
+ (elmo-net-parse-network): Abolish.
+ (elmo-net-folder-set-parameters): New function.
+ (elmo-folder-initialize): Follow the above change.
+
+ * elmo-imap4.el (elmo-imap4-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+ (elmo-folder-list-subfolders): Use
+ `elmo-quote-syntactical-element' instead of
+ `elmo-net-format-quoted' to quote mailbox and user name.
+
2005-06-07 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* elmo-util.el (elmo-token-valid-p): New function.
(personal "$Personal")
(shouldreply "$ShouldReply")))
+(defconst elmo-imap4-folder-name-syntax
+ `(mailbox
+ (?: [user "^[A-Za-z]"] (?/ [auth ".+"]))
+ ,@elmo-net-folder-name-syntax))
+
;; For debugging.
(defvar elmo-imap4-debug nil
"Non-nil forces IMAP4 folder as debug mode.
(append elmo-imap4-stream-type-alist
elmo-network-stream-type-alist)
elmo-network-stream-type-alist))
- parse)
+ tokens)
(when (string-match "\\(.*\\)@\\(.*\\)" default-server)
;; case: imap4-default-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 tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-imap4-folder-name-syntax)))
;; mailbox
- (setq parse (elmo-parse-token name ":@:!"))
(elmo-imap4-folder-set-mailbox-internal folder
(elmo-imap4-encode-folder-string
- (car parse)))
+ (cdr (assq 'mailbox tokens))))
;; user
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "/@:!"
- "^[A-Za-z]+"))
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- default-user
- (car parse)))
+ (or (cdr (assq 'user tokens))
+ default-user))
;; auth
- (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) "@:!"))
(elmo-net-folder-set-auth-internal
folder
- (if (eq (length (car parse)) 0)
- (or elmo-imap4-default-authenticate-type 'clear)
- (intern (car parse))))
+ (let ((auth (cdr (assq 'auth tokens))))
+ (or (and auth (intern auth))
+ elmo-imap4-default-authenticate-type
+ 'clear)))
;; network
- (elmo-net-parse-network folder (cdr parse))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server default-server
+ :port default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
folder))
;;; ELMO IMAP4 folder
(not (eq (elmo-net-folder-auth-internal folder)
(or elmo-imap4-default-authenticate-type 'clear))))
(setq append-serv (concat ":"
- (elmo-net-format-quoted
- (elmo-net-folder-user-internal folder) "/"))))
+ (elmo-quote-syntactical-element
+ (elmo-net-folder-user-internal folder)
+ 'user elmo-imap4-folder-name-syntax))))
(unless (eq (elmo-net-folder-auth-internal folder)
(or elmo-imap4-default-authenticate-type 'clear))
(setq append-serv
fld))
(cdr result)))
folder (concat prefix
- (elmo-net-format-quoted
- (elmo-imap4-decode-folder-string folder) ":")
+ (elmo-quote-syntactical-element
+ (elmo-imap4-decode-folder-string folder)
+ 'mailbox elmo-imap4-folder-name-syntax)
(and append-serv
(eval append-serv)))
ret (append ret (if has-child-p
ret)
(mapcar (lambda (fld)
(concat prefix
- (elmo-net-format-quoted
- (elmo-imap4-decode-folder-string fld) ":")
+ (elmo-quote-syntactical-element
+ (elmo-imap4-decode-folder-string fld)
+ 'mailbox elmo-imap4-folder-name-syntax)
(and append-serv
(eval append-serv))))
result))))
;;; Code:
;;
+(defconst elmo-net-folder-name-syntax '((?@ [server ".+"])
+ (?: [port "^[0-9]+$"])
+ (?! stream-type)))
+
;;; ELMO net folder
(eval-and-compile
(luna-define-class elmo-net-folder
(elmo-quoted-token string)
string))
-(defun elmo-net-parse-network (folder network)
- (let (parse)
+(defun elmo-net-folder-set-parameters (folder tokens &optional defaults)
+ (let ((port (cdr (assq 'port tokens)))
+ (stream-type (cdr (assq 'stream-type tokens))))
;; server
- (setq parse (elmo-parse-prefixed-element ?@ network ":!"))
- (when (> (length (car parse)) 0)
- (elmo-net-folder-set-server-internal folder (car parse)))
+ (elmo-net-folder-set-server-internal
+ folder
+ (or (cdr (assq 'server tokens))
+ (plist-get defaults :server)))
;; port
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "!"))
- (when (> (length (car parse)) 0)
- (elmo-net-folder-set-port-internal folder (string-to-int (car parse))))
+ (elmo-net-folder-set-port-internal
+ folder
+ (or (and port (string-to-int port))
+ (plist-get defaults :port)))
;; stream-type
(elmo-net-folder-set-stream-type-internal
folder
- (assoc (cdr parse) elmo-network-stream-type-alist))))
+ (or (and stream-type (assoc (concat "!" stream-type)
+ elmo-network-stream-type-alist))
+ (plist-get defaults :stream-type)))))
(luna-define-method elmo-folder-initialize ((folder elmo-net-folder) name)
;; user and auth should be set in subclass.
(when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
- (elmo-net-parse-network folder (substring name (match-beginning 0))))
+ (elmo-net-folder-set-parameters
+ folder
+ (car (elmo-parse-separated-tokens
+ (substring name (match-beginning 0))
+ elmo-net-folder-name-syntax))))
folder)
(luna-define-method elmo-net-port-info ((folder elmo-net-folder))
(defvar elmo-nntp-group-coding-system nil
"A coding system for newsgroup string.")
+(defconst elmo-nntp-folder-name-syntax `(group
+ (?: [user "^\\([A-Za-z]\\|$\\)"])
+ ,@elmo-net-folder-name-syntax))
+
(defsubst elmo-nntp-encode-group-string (string)
(if elmo-nntp-group-coding-system
(encode-coding-string string elmo-nntp-group-coding-system)
(append elmo-nntp-stream-type-alist
elmo-network-stream-type-alist))
elmo-network-stream-type-alist))
- explicit-user parse)
- (setq parse (elmo-parse-token name ":@!"))
+ tokens)
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-nntp-folder-name-syntax)))
+ ;; group
(elmo-nntp-folder-set-group-internal folder
(elmo-nntp-encode-group-string
- (car parse)))
- (setq explicit-user (eq ?: (string-to-char (cdr parse))))
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "@:!"
- "^[A-Za-z]+"))
+ (cdr (assq 'group tokens))))
+ ;; user
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- (unless explicit-user
- elmo-nntp-default-user)
- (car parse)))
+ (let ((user (cdr (assq 'user tokens))))
+ (if user
+ (and (> (length user) 0) user)
+ elmo-nntp-default-user)))
;; network
- (elmo-net-parse-network folder (cdr parse))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder
- elmo-nntp-default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder
- elmo-nntp-default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type
- elmo-nntp-default-stream-type)))
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server elmo-nntp-default-server
+ :port elmo-nntp-default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-nntp-default-stream-type)))
folder))
(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
(elmo-display-progress
'elmo-nntp-list-folders "Parsing active..." 100))))
- (setq username (elmo-net-folder-user-internal folder))
- (when (and username
- elmo-nntp-default-user
- (string= username elmo-nntp-default-user))
- (setq username nil))
-
- (when (or username ; XXX: ad-hoc fix against username includes "@"
- (not (string= (elmo-net-folder-server-internal folder)
- elmo-nntp-default-server)))
- (setq append-serv (concat "@" (elmo-net-folder-server-internal
- folder))))
+ (setq username (or (elmo-net-folder-user-internal folder) ""))
+ (unless (string= username (or elmo-nntp-default-user ""))
+ (setq append-serv (concat append-serv
+ ":" (elmo-quote-syntactical-element
+ username
+ 'user elmo-nntp-folder-name-syntax))))
+ (unless (string= (elmo-net-folder-server-internal folder)
+ elmo-nntp-default-server)
+ (setq append-serv (concat append-serv
+ "@" (elmo-net-folder-server-internal folder))))
(unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
(setq append-serv (concat append-serv
":" (int-to-string
(concat append-serv
(elmo-network-stream-type-spec-string
(elmo-net-folder-stream-type-internal folder)))))
- (mapcar '(lambda (fld)
- (if (consp fld)
- (list (concat "-" (elmo-nntp-decode-group-string (car fld))
- (and username
- (concat
- ":"
- username))
- (and append-serv
- (concat append-serv))))
- (concat "-" (elmo-nntp-decode-group-string fld)
- (and username
- (concat ":" username))
- (and append-serv
- (concat append-serv)))))
+ (mapcar (lambda (fld)
+ (if (consp fld)
+ (list (concat "-" (elmo-nntp-decode-group-string (car fld))
+ append-serv))
+ (concat "-" (elmo-nntp-decode-group-string fld) append-serv)))
ret-val)))
(defun elmo-nntp-make-msglist (beg-str end-str)
:type 'boolean
:group 'elmo)
+(defconst elmo-pop3-folder-name-syntax `(([user ".+"])
+ (?/ [auth ".+"])
+ (?: [uidl "^[A-Za-z]+$"])
+ ,@elmo-net-folder-name-syntax))
+
(defvar sasl-mechanism-alist)
(defvar elmo-pop3-total-size nil)
(append elmo-pop3-stream-type-alist
elmo-network-stream-type-alist)
elmo-network-stream-type-alist))
- parse)
+ tokens auth uidl)
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-pop3-folder-name-syntax)))
;; user
- (setq parse (elmo-parse-token name "/@:!"))
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-user
- (car parse)))
+ (or (cdr (assq 'user tokens))
+ elmo-pop3-default-user))
;; auth
- (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":@!"))
+ (setq auth (cdr (assq 'auth tokens)))
(elmo-net-folder-set-auth-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-authenticate-type
- (intern (downcase (car parse)))))
+ (if auth
+ (intern (downcase auth))
+ elmo-pop3-default-authenticate-type))
;; uidl
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "@:!" "^[a-z]+"))
+ (setq uidl (cdr (assq 'uidl tokens)))
(elmo-pop3-folder-set-use-uidl-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-use-uidl
- (string= (car parse) "uidl")))
+ (if uidl
+ (string= uidl "uidl")
+ elmo-pop3-default-use-uidl))
;; network
- (elmo-net-parse-network folder (cdr parse))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder
- elmo-pop3-default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder
- elmo-pop3-default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type
- elmo-pop3-default-stream-type)))
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server elmo-pop3-default-server
+ :port elmo-pop3-default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-pop3-default-stream-type)))
folder))
;;; POP3 session
parsed
(cons "" string))))
+(defun elmo-collect-separators (spec)
+ (when (listp spec)
+ (let ((result (elmo-collect-separators-internal spec)))
+ (and result
+ (char-list-to-string (elmo-uniq-list result #'delq))))))
+
+(defun elmo-collect-separators-internal (specs)
+ (let (separators)
+ (while specs
+ (let ((spec (car specs)))
+ (cond
+ ((listp spec)
+ (setq separators (nconc (elmo-collect-separators-internal spec)
+ separators)
+ specs (cdr specs)))
+ ((characterp spec)
+ (setq separators (cons spec separators)
+ specs nil))
+ (t
+ (setq specs nil)))))
+ separators))
+
+(defun elmo-collect-trail-separators (element specs)
+ (cond
+ ((symbolp specs)
+ (eq specs element))
+ ((vectorp specs)
+ (eq (aref specs 0) element))
+ ((listp specs)
+ (let (spec result)
+ (while (setq spec (car specs))
+ (if (setq result (elmo-collect-trail-separators element spec))
+ (setq result (concat (if (stringp result) result)
+ (elmo-collect-separators (cdr specs)))
+ specs nil)
+ (setq specs (cdr specs))))
+ result))))
+
+(defun elmo-parse-separated-tokens (string spec)
+ (let ((result (elmo-parse-separated-tokens-internal string spec)))
+ (if (eq (car result) t)
+ (cons nil (cdr result))
+ result)))
+
+(defun elmo-parse-separated-tokens-internal (string spec &optional separators)
+ (cond
+ ((symbolp spec)
+ (let ((parse (elmo-parse-token string separators)))
+ (cons (list (cons spec (car parse))) (cdr parse))))
+ ((vectorp spec)
+ (let ((parse (elmo-parse-token string separators)))
+ (if (elmo-token-valid-p (car parse) (aref spec 1))
+ (cons (list (cons (aref spec 0) (car parse))) (cdr parse))
+ (cons nil string))))
+ ((characterp spec)
+ (if (and (> (length string) 0)
+ (eq (aref string 0) spec))
+ (cons t (substring string 1))
+ (cons nil string)))
+ ((listp spec)
+ (catch 'unmatch
+ (let ((rest string)
+ result tokens)
+ (while spec
+ (setq result (elmo-parse-separated-tokens-internal
+ rest
+ (car spec)
+ (concat (elmo-collect-separators (cdr spec))
+ separators)))
+ (cond ((null (car result))
+ (throw 'unmatch (cons t string)))
+ ((eq t (car result)))
+ (t
+ (setq tokens (nconc (car result) tokens))))
+ (setq rest (cdr result)
+ spec (cdr spec)))
+ (cons (or tokens t) rest))))))
+
+(defun elmo-quote-syntactical-element (value element syntax)
+ (let ((separators (elmo-collect-trail-separators element syntax)))
+ (if (and separators
+ (string-match (concat "[" separators "]") value))
+ (elmo-quoted-token value)
+ value)))
+
;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
;;
;; number ::= [0-9]+
projects / elisp / wanderlust.git / commitdiff