X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=49326f0e23b21c2a960bc0a2912ce1eb1168e272;hb=115948d94e27121bac9b14f71665e39617b8bdb3;hp=b4046910e648aeadc476116253618879a8ea03e4;hpb=8d56bd754fd5060c731102293a32db2ddd2508ab;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index b404691..49326f0 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -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 "$") @@ -332,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) @@ -685,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." @@ -707,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." @@ -734,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) @@ -936,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)) @@ -974,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 @@ -1087,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) @@ -1346,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." @@ -1830,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) @@ -1868,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.