X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=49326f0e23b21c2a960bc0a2912ce1eb1168e272;hb=115948d94e27121bac9b14f71665e39617b8bdb3;hp=be810a92b10b7a2bb34672d08689f3ad8f304fdd;hpb=47972777916535ae9ea19df8ae993dd0aba58546;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index be810a9..49326f0 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -125,7 +125,7 @@ File content is encoded with MIME-CHARSET." (encode-mime-charset-region (point-min) (point-max) mime-charset)) (as-binary-output-file (write-region (point-min) (point-max) filename nil 'no-msg))) - (message (format "%s is not writable." filename))))) + (message "%s is not writable." filename)))) (defun elmo-object-save (filename object &optional mime-charset) "Save OBJECT to the file specified by FILENAME. @@ -170,12 +170,15 @@ File content is encoded with MIME-CHARSET." (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)))) + (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)))) (t (setq value (read-from-minibuffer (format "Value for '%s': " field))) (unless (string-match (concat "^" elmo-condition-atom-regexp "$") @@ -254,6 +257,7 @@ Return value is a cons cell of (STRUCTURE . REST)" ;; time ::= "yesterday" / "lastweek" / "lastmonth" / "lastyear" / ;; number SPACE* "daysago" / ;; number "-" month "-" number ; ex. 10-May-2000 +;; number "-" number "-" number ; ex. 2000-05-10 ;; number ::= [0-9]+ ;; month ::= "Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" / ;; "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec" @@ -270,6 +274,7 @@ Return value is a cons cell of (STRUCTURE . REST)" (looking-at "lastmonth") (looking-at "lastyear") (looking-at "[0-9]+ *daysago") (looking-at "[0-9]+-[A-Za-z]+-[0-9]+") + (looking-at "[0-9]+-[0-9]+-[0-9]+") (looking-at "[0-9]+") (looking-at elmo-condition-atom-regexp)) (prog1 (elmo-match-buffer 0) @@ -330,17 +335,12 @@ Return value is a cons cell of (STRUCTURE . REST)" lst) (defun elmo-list-insert (list element after) - "Insert an ELEMENT to the LIST, just after AFTER." - (let ((li list) - (curn 0) - p pn) - (while li - (if (eq (car li) after) - (setq p li pn curn li nil) - (incf curn)) - (setq li (cdr li))) - (if pn - (setcdr (nthcdr pn list) (cons element (cdr p))) + (let* ((match (memq after list)) + (rest (and match (cdr (memq after list))))) + (if match + (progn + (setcdr match (list element)) + (nconc list rest)) (nconc list (list element))))) (defun elmo-string-partial-p (string) @@ -430,7 +430,7 @@ Return value is a cons cell of (STRUCTURE . REST)" (write-region (point-min) (point-max) filename nil 'no-msg) (set-file-modes filename 384)) - (message (format "%s is not writable." filename))) + (message "%s is not writable." filename)) (kill-buffer tmp-buffer)))) (defun elmo-get-passwd (key) @@ -683,7 +683,8 @@ Return value is a cons cell of (STRUCTURE . REST)" (setq result (+ result (or (elmo-disk-usage (car files)) 0))) (setq files (cdr files))) result) - (float (nth 7 file-attr)))))) + (float (nth 7 file-attr))) + 0))) (defun elmo-get-last-accessed-time (path &optional dir) "Return the last accessed time of PATH." @@ -705,14 +706,14 @@ Return value is a cons cell of (STRUCTURE . REST)" (setq last-modified (+ (* (nth 0 last-modified) (float 65536)) (nth 1 last-modified))))) -(defun elmo-make-directory (path) +(defun elmo-make-directory (path &optional mode) "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-directory)) - (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700 + (set-file-modes path (or mode + (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700 (defun elmo-delete-directory (path &optional no-hierarchy) "Delete directory recursively." @@ -732,6 +733,18 @@ Return value is a cons cell of (STRUCTURE . REST)" (unless hierarchy (delete-directory path))))) +(defun elmo-delete-match-files (path regexp &optional remove-if-empty) + "Delete directory files specified by PATH. +If optional REMOVE-IF-EMPTY is non-nil, delete directory itself if +the directory becomes empty after deletion." + (when (stringp path) ; nil is not permitted. + (dolist (file (directory-files path t regexp)) + (delete-file file)) + (if remove-if-empty + (ignore-errors + (delete-directory path) ; should be removed if empty. + )))) + (defun elmo-list-filter (l1 l2) "L1 is filter." (if (eq l1 t) @@ -793,6 +806,9 @@ Return value is a cons cell of (STRUCTURE . REST)" (setq l1 (cdr l1))) (cons diff1 (list l2))))) +(defmacro elmo-filter-condition-p (filter) + `(or (vectorp ,filter) (consp ,filter))) + (defmacro elmo-filter-type (filter) (` (aref (, filter) 0))) @@ -816,29 +832,26 @@ Return value is a cons cell of (STRUCTURE . REST)" (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)))) + (let ((field-date (elmo-date-make-sortable-string + (timezone-fix-time + (std11-field-body "date") + (current-time-zone) nil))) + (specified-date (elmo-date-make-sortable-string + (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")))))) + (or (string= field-date specified-date) + (string< specified-date field-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))))))) + (setq result + (string< + (elmo-date-make-sortable-string + (timezone-fix-time + (std11-field-body "date") + (current-time-zone) nil)) + (elmo-date-make-sortable-string + (elmo-date-get-datevec + (elmo-filter-value condition)))))) ((string= (elmo-filter-key condition) "body") (and (re-search-forward "^$" nil t) ; goto body (setq result (search-forward (elmo-filter-value condition) @@ -934,9 +947,10 @@ Return value is a cons cell of (STRUCTURE . REST)" file (nth 2 condition) number number-list))))) (defmacro elmo-get-hash-val (string hashtable) - (let ((sym (list 'intern-soft string hashtable))) - (list 'if (list 'boundp sym) - (list 'symbol-value sym)))) + `(and (stringp ,string) + (let ((sym (intern-soft ,string ,hashtable))) + (if (boundp sym) + (symbol-value sym))))) (defmacro elmo-set-hash-val (string value hashtable) (list 'set (list 'intern string hashtable) value)) @@ -972,15 +986,16 @@ Emacs 19.28 or earlier does not have `unintern'." (defsubst elmo-mime-string (string) "Normalize MIME encoded STRING." - (and string - (let (str) - (elmo-set-work-buf - (elmo-set-buffer-multibyte default-enable-multibyte-characters) - (setq str (eword-decode-string - (decode-mime-charset-string string elmo-mime-charset))) - (setq str (encode-mime-charset-string str elmo-mime-charset)) - (elmo-set-buffer-multibyte nil) - str)))) + (and string + (elmo-set-work-buf + (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (setq string + (encode-mime-charset-string + (eword-decode-and-unfold-unstructured-field-body + string) + elmo-mime-charset)) + (elmo-set-buffer-multibyte nil) + string))) (defsubst elmo-collect-field (beg end downcase-field-name) (save-excursion @@ -1085,13 +1100,15 @@ Emacs 19.28 or earlier does not have `unintern'." (setq lst (cdr lst))) result)) -(defun elmo-list-delete (list1 list2) +(defun elmo-list-delete (list1 list2 &optional delete-function) "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'." +the value of `foo'. +If optional DELETE-FUNCTION is speficied, it is used as delete procedure." + (setq delete-function (or delete-function 'delete)) (while list1 - (setq list2 (delete (car list1) list2)) + (setq list2 (funcall delete-function (car list1) list2)) (setq list1 (cdr list1))) list2) @@ -1176,7 +1193,9 @@ the value of `foo'." (defun elmo-progress-clear (label) (let ((counter (assq label elmo-progress-counter-alist))) (when counter - (elmo-display-progress label "" 100) + (elmo-display-progress label + (elmo-progress-counter-format counter) + 100) (setq elmo-progress-counter-alist (delq counter elmo-progress-counter-alist))))) @@ -1225,7 +1244,7 @@ the value of `foo'." (defmacro elmo-string (string) "STRING without text property." (` (let ((obj (copy-sequence (, string)))) - (set-text-properties 0 (length obj) nil obj) + (and obj (set-text-properties 0 (length obj) nil obj)) obj))) (defun elmo-flatten (list-of-list) @@ -1342,6 +1361,39 @@ But if optional argument AUTO is non-nil, DEFAULT is returned." (setq alist (cdr alist))) matches)) +(defun elmo-expand-newtext (newtext original) + (let ((len (length newtext)) + (pos 0) + c expanded beg N did-expand) + (while (< pos len) + (setq beg pos) + (while (and (< pos len) + (not (= (aref newtext pos) ?\\))) + (setq pos (1+ pos))) + (unless (= beg pos) + (push (substring newtext beg pos) expanded)) + (when (< pos len) + ;; We hit a \; expand it. + (setq did-expand t + pos (1+ pos) + c (aref newtext pos)) + (if (not (or (= c ?\&) + (and (>= c ?1) + (<= c ?9)))) + ;; \ followed by some character we don't expand. + (push (char-to-string c) expanded) + ;; \& or \N + (if (= c ?\&) + (setq N 0) + (setq N (- c ?0))) + (when (match-beginning N) + (push (substring original (match-beginning N) (match-end N)) + expanded)))) + (setq pos (1+ pos))) + (if did-expand + (apply (function concat) (nreverse expanded)) + newtext))) + ;;; Folder parser utils. (defun elmo-parse-token (string &optional seps) "Parse atom from STRING using SEPS as a string of separator char list." @@ -1567,16 +1619,14 @@ SECTION is the section string." (defun elmo-file-cache-delete (path) "Delete a cache on PATH." - (let (files) - (when (file-exists-p path) - (if (file-directory-p path) - (progn - (setq files (directory-files path t "^[^\\.]")) - (while files - (delete-file (car files)) - (setq files (cdr files))) - (delete-directory path)) - (delete-file path))))) + (when (file-exists-p path) + (if (file-directory-p path) + (progn + (dolist (file (directory-files path t "^[^\\.]")) + (delete-file file)) + (delete-directory path)) + (delete-file path)) + t)) (defun elmo-file-cache-exists-p (msgid) "Returns 'section or 'entire if a cache which corresponds to MSGID exists." @@ -1828,15 +1878,18 @@ If KBYTES is kilo bytes (This value must be float)." ;;; ;; Warnings. -(defconst elmo-warning-buffer-name "*elmo warning*") - -(defun elmo-warning (&rest args) - "Display a warning, making warning message by passing all args to `insert'." - (with-current-buffer (get-buffer-create elmo-warning-buffer-name) - (goto-char (point-max)) - (apply 'insert (append args '("\n"))) - (recenter 1)) - (display-buffer elmo-warning-buffer-name)) +(static-if (fboundp 'display-warning) + (defmacro elmo-warning (&rest args) + "Display a warning with `elmo' group." + `(display-warning 'elmo (format ,@args))) + (defconst elmo-warning-buffer-name "*elmo warning*") + (defun elmo-warning (&rest args) + "Display a warning. ARGS are passed to `format'." + (with-current-buffer (get-buffer-create elmo-warning-buffer-name) + (goto-char (point-max)) + (funcall 'insert (apply 'format (append args '("\n")))) + (ignore-errors (recenter 1)) + (display-buffer elmo-warning-buffer-name)))) (defvar elmo-obsolete-variable-alist nil) @@ -1866,9 +1919,9 @@ If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message." (defvaralias var obsolete) (set var (symbol-value obsolete))) (if elmo-obsolete-variable-show-warnings - (elmo-warning (format "%s is obsolete. Use %s instead." - (symbol-name obsolete) - (symbol-name var)))))) + (elmo-warning "%s is obsolete. Use %s instead." + (symbol-name obsolete) + (symbol-name var))))) (defun elmo-resque-obsolete-variables (&optional alist) "Resque obsolete variables in ALIST.