+2005-01-30 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
* elmo-imap4.el (elmo-folder-list-subfolders): Use root mailbox without
"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))
(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
(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)))
+2005-01-30 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
* wl-summary.el (wl-summary-reedit): Call
(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))))))
(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))))
(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
'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
(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))
(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
;;; Code:
;;
(require 'bytecomp)
-(eval-when-compile
- (require 'elmo-util))
+(require 'elmo-util)
+(require 'elmo-flag)
(condition-case nil (require 'pp) (error nil))
(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))
projects / elisp / wanderlust.git / commitdiff