From d4eb9c80559ae231d9593bb51887705fb90fad33 Mon Sep 17 00:00:00 2001 From: hmurata Date: Fri, 10 Jun 2005 02:11:47 +0000 Subject: [PATCH] * 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. --- doc/wl-ja.texi | 4 +-- doc/wl.texi | 4 +-- elmo/ChangeLog | 27 +++++++++++++++++ elmo/elmo-imap4.el | 59 +++++++++++++++++++----------------- elmo/elmo-net.el | 33 +++++++++++++------- elmo/elmo-nntp.el | 84 +++++++++++++++++++++++---------------------------- elmo/elmo-pop3.el | 51 +++++++++++++++---------------- elmo/elmo-util.el | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 234 insertions(+), 113 deletions(-) diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 6a51ac2..d8008d5 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -869,7 +869,7 @@ cvs -d :pserver:anonymous@@cvs.m17n.org:/cvs/root checkout ucs-conv @example @group -@samp{-} @var{$B%K%e!<%9%0%k!<%WL>(B} [[@samp{:} @var{$B%f!<%6L>(B}][@samp{@@} @var{$B%[%9%HL>(B}][@samp{:} @var{$B%]!<%HHV9f(B}]][@samp{!}] +@samp{-} @var{$B%K%e!<%9%0%k!<%WL>(B} [@samp{:} @var{$B%f!<%6L>(B}][@samp{@@} @var{$B%[%9%HL>(B}][@samp{:} @var{$B%]!<%HHV9f(B}][@samp{!}] @end group @end example @@ -1251,7 +1251,7 @@ RFC 1939 $B$G5,Dj$5$l$F$$$k(B POP3 $B$rMxMQ$7$F%a!<%k$rFI$`$?$a$N%U%)%k%@$G$9 @example @group -@samp{&} [@var{$B%f!<%6L>(B}][[@samp{/} @var{$BG'>ZK!(B}][@samp{:} @var{$BHV9f$N?6$jJ}(B}][@samp{@@} @var{$B%[%9%HL>(B}][@samp{:} @var{$B%]!<%HHV9f(B}]][@samp{!}] +@samp{&} [@var{$B%f!<%6L>(B}][@samp{/} @var{$BG'>ZK!(B}][@samp{:} @var{$BHV9f$N?6$jJ}(B}][@samp{@@} @var{$B%[%9%HL>(B}][@samp{:} @var{$B%]!<%HHV9f(B}][@samp{!}] @end group @end example diff --git a/doc/wl.texi b/doc/wl.texi index 4fb20d0..47f592b 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -837,7 +837,7 @@ Format: @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 @@ -1226,7 +1226,7 @@ Format: @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 diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 6faa594..9fe9b7c 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,30 @@ +2005-06-10 Hiroya Murata + + * 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 * elmo-util.el (elmo-token-valid-p): New function. diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 978a3bc..6f87018 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -174,6 +174,11 @@ REGEXP should have a grouping for namespace prefix.") (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. @@ -1845,41 +1850,38 @@ Return nil if no complete line has arrived." (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 @@ -1992,8 +1994,9 @@ Return nil if no complete line has arrived." (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 @@ -2043,8 +2046,9 @@ Return nil if no complete line has arrived." 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 @@ -2053,8 +2057,9 @@ Return nil if no complete line has arrived." 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)))) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index e4c6ecc..630bf46 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -37,6 +37,10 @@ ;;; 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 @@ -318,25 +322,34 @@ Returned value is searched from `elmo-network-stream-type-alist'." (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)) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 0a2ab4e..0db74cb 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -55,6 +55,10 @@ (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) @@ -94,32 +98,28 @@ Debug information is inserted in the buffer \"*NNTP DEBUG*\"") (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)) @@ -587,17 +587,16 @@ Don't cache if nil.") (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 @@ -609,20 +608,11 @@ Don't cache if nil.") (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) diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 6a78d94..06e0a04 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -61,6 +61,11 @@ set as non-nil.") :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) @@ -93,38 +98,34 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (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 diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 88a9741..8953d0f 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1506,6 +1506,91 @@ ELT must be a string. Upper-case and lower-case letters are treated as equal." 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 ;; ;; number ::= [0-9]+ -- 1.7.10.4