From: hmurata Date: Sun, 30 Jan 2005 11:29:18 +0000 (+0000) Subject: * wl-util.el (toplevel): Require 'elmo-flag'. X-Git-Tag: wl-2_14-root~70 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a332b51cafea0174c5f3b308575bf54116f65e9d;p=elisp%2Fwanderlust.git * wl-util.el (toplevel): Require 'elmo-flag'. (wl-read-search-condition): New function (Renamed from `elmo-read-search-condition'). (wl-read-search-condition-internal): Likewise. * wl-summary.el (wl-summary-decide-flag): Cause error if flag is invalid. (wl-summary-pick): Use `wl-read-search-condition' instead of `elmo-read-search-condition'. (wl-summary-virtual): Ditto. * wl-folder.el (wl-folder-virtual): Ditto. (wl-folder-pick): Ditto. * wl-fldmgr.el (wl-fldmgr-make-filter): Ditto. * elmo-util.el (elmo-read-search-condition): Eliminate (renamed to `wl-read-search-condition'). (elmo-read-search-condition-internal): Likewise. * elmo-flag.el (elmo-flag-char-regexp): New constant. (elmo-flag-valid-p): New function. (elmo-folder-initialize): Check flag name is valid. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 8b35b64..1ae8acc 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,13 @@ +2005-01-30 Hiroya Murata + + * elmo-util.el (elmo-read-search-condition): Eliminate (renamed to + `wl-read-search-condition'). + (elmo-read-search-condition-internal): Likewise. + + * elmo-flag.el (elmo-flag-char-regexp): New constant. + (elmo-flag-valid-p): New function. + (elmo-folder-initialize): Check flag name is valid. + 2005-01-26 Yuuichi Teranishi * elmo-imap4.el (elmo-folder-list-subfolders): Use root mailbox without diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el index 836490c..52f791b 100644 --- a/elmo/elmo-flag.el +++ b/elmo/elmo-flag.el @@ -44,6 +44,16 @@ "Internal variable to hold global-flag-folder structures.") (eval-and-compile + (defconst elmo-flag-char-regexp "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-")) + +(defun elmo-flag-valid-p (flag) + (unless (stringp flag) + (setq flag (symbol-name flag))) + (string-match (eval-when-compile + (concat "^[" elmo-flag-char-regexp "]+$")) + flag)) + +(eval-and-compile (luna-define-class elmo-flag-folder (elmo-localdir-folder) (flag minfo minfo-hash max-number)) (luna-define-internal-accessors 'elmo-flag-folder)) @@ -51,8 +61,14 @@ (luna-define-method elmo-folder-initialize ((folder elmo-flag-folder) name) - (if (string-match "flag/\\([a-z]+\\)" name) - (setq name (match-string 1 name)) + (unless (string-match (eval-when-compile + (concat "^flag\\(/\\([" + elmo-flag-char-regexp + "]+\\)\\)?")) + name) + (error "Error in folder name `%s'" (elmo-folder-name-internal folder))) + (if (match-beginning 1) + (setq name (match-string 2 name)) (setq name (symbol-name (car elmo-global-flags))) (elmo-folder-set-name-internal folder diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 95ace75..dbaebc7 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -139,61 +139,6 @@ File content is encoded with MIME-CHARSET." (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))) diff --git a/wl/ChangeLog b/wl/ChangeLog index 522808b..6dc114c 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,21 @@ +2005-01-30 Hiroya Murata + + * wl-util.el (toplevel): Require 'elmo-flag'. + (wl-read-search-condition): New function (Renamed from + `elmo-read-search-condition'). + (wl-read-search-condition-internal): Likewise. + + * wl-summary.el (wl-summary-decide-flag): Cause error if flag is + invalid. + (wl-summary-pick): Use `wl-read-search-condition' instead of + `elmo-read-search-condition'. + (wl-summary-virtual): Ditto. + + * wl-folder.el (wl-folder-virtual): Ditto. + (wl-folder-pick): Ditto. + + * wl-fldmgr.el (wl-fldmgr-make-filter): Ditto. + 2005-01-28 Hiroya Murata * wl-summary.el (wl-summary-reedit): Call diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index b84d9ed..821e144 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -1040,7 +1040,7 @@ return value is diffs '(-new -unread -all)." (setq entity (nth 4 tmp))) (unless entity (error "No folder")) (wl-fldmgr-add (concat "/" - (elmo-read-search-condition + (wl-read-search-condition wl-fldmgr-make-filter-default) "/" entity)))))) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 4e53bb8..835715d 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -2926,7 +2926,7 @@ Call `wl-summary-write-current-folder' with current folder name." (unless entity (error "No folder")) (wl-folder-goto-folder-subr (concat "/" - (elmo-read-search-condition + (wl-read-search-condition wl-fldmgr-make-filter-default) "/" entity)))) @@ -2934,7 +2934,7 @@ Call `wl-summary-write-current-folder' with current folder name." (interactive) (save-excursion (let* ((condition (car (elmo-parse-search-condition - (elmo-read-search-condition + (wl-read-search-condition wl-summary-pick-field-default)))) (entity (wl-folder-get-entity-from-buffer)) (folder-list diff --git a/wl/wl-summary.el b/wl/wl-summary.el index b9b60fd..3cc4b96 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -2831,7 +2831,7 @@ If ARG, without confirm." 'in-msgdb) (error "No messages"))) (condition (car (elmo-parse-search-condition - (elmo-read-search-condition + (wl-read-search-condition wl-summary-pick-field-default)))) (result (elmo-folder-search wl-summary-buffer-elmo-folder condition @@ -2872,7 +2872,7 @@ If ARG, exit virtual folder." (if arg (wl-summary-unvirtual) (wl-summary-goto-folder-subr (concat "/" - (elmo-read-search-condition + (wl-read-search-condition wl-summary-pick-field-default) "/" (wl-summary-buffer-folder-name)) @@ -3337,6 +3337,8 @@ Return non-nil if the mark is updated" (unless (memq flag elmo-global-flags) (when (elmo-local-flag-p flag) (error "Cannot treat `%s'." flag)) + (unless (elmo-flag-valid-p flag) + (error "Invalid char in `%s'" flag)) (if (y-or-n-p (format "Flag `%s' is not registered yet. Register?" (capitalize (symbol-name flag)))) (setq elmo-global-flags (append diff --git a/wl/wl-util.el b/wl/wl-util.el index b8771db..114cdf3 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -33,8 +33,8 @@ ;;; Code: ;; (require 'bytecomp) -(eval-when-compile - (require 'elmo-util)) +(require 'elmo-util) +(require 'elmo-flag) (condition-case nil (require 'pp) (error nil)) @@ -1043,6 +1043,72 @@ is enclosed by at least one regexp grouping construct." (with-current-buffer src (symbol-value variable)))))) +;;; Search Condition +(defun wl-read-search-condition (default) + "Read search condition string interactively." + (wl-read-search-condition-internal "Search by" default)) + +(defun wl-read-search-condition-internal (prompt default &optional paren) + (let* ((completion-ignore-case t) + (denial-fields (nconc (mapcar 'capitalize elmo-msgdb-extra-fields) + '("Flag" "Since" "Before" + "From" "Subject" "To" "Cc" "Body" "ToCc"))) + (field (completing-read + (format "%s (%s): " prompt default) + (mapcar 'list + (append '("AND" "OR" "Last" "First") + denial-fields + (mapcar (lambda (f) (concat "!" f)) + denial-fields))))) + value) + (setq field (if (string= field "") + (setq field default) + field)) + (cond + ((or (string= field "AND") (string= field "OR")) + (concat (if paren "(" "") + (wl-read-search-condition-internal + (concat field "(1) Search by") default 'paren) + (if (string= field "AND") "&" "|") + (wl-read-search-condition-internal + (concat field "(2) Search by") default 'paren) + (if paren ")" ""))) + ((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-match "!?Flag" field) + (while (null value) + (setq value (downcase + (completing-read + (format "Value for '%s': " field) + (mapcar (lambda (f) (list (capitalize (symbol-name f)))) + (elmo-uniq-list + (append + '(unread answered forwarded digest any) + elmo-global-flags) + #'delq))))) + (unless (elmo-flag-valid-p value) + (message "Invalid char in `%s'" value) + (setq value nil) + (sit-for 1))) + (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))))) + (require 'product) (product-provide (provide 'wl-util) (require 'wl-version))