X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=aff84f3ba1bb000427da030cae70fd4acc62736b;hb=13ea09ab66b44b1a3b0971e1a24ce0da47a6ca0a;hp=5b774f062e3725eeb3a459a45b1ce79a7ea7d19e;hpb=44a57cc09a5b8df1f493a0ac9fdae8041a76f44b;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 5b774f0..aff84f3 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -29,7 +29,9 @@ ;;; Code: ;; -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'static)) (require 'elmo-vars) (require 'elmo-date) (require 'mcharset) @@ -60,27 +62,27 @@ (fset 'elmo-base64-decode-string (mel-find-function 'mime-decode-string "base64")) -(if elmo-use-hardlink - (defalias 'elmo-add-name-to-file 'add-name-to-file) - (defun elmo-add-name-to-file - (filename newname &optional ok-if-already-exists) - (copy-file filename newname ok-if-already-exists t))) +(eval-and-compile + (if elmo-use-hardlink + (defalias 'elmo-add-name-to-file 'add-name-to-file) + (defun elmo-add-name-to-file + (filename newname &optional ok-if-already-exists) + (copy-file filename newname ok-if-already-exists t)))) (defmacro elmo-set-work-buf (&rest body) "Execute BODY on work buffer. Work buffer remains." - (` (save-excursion - (set-buffer (get-buffer-create elmo-work-buf-name)) - (set-buffer-multibyte default-enable-multibyte-characters) - (erase-buffer) - (,@ body)))) + `(with-current-buffer (get-buffer-create elmo-work-buf-name) + (set-buffer-multibyte default-enable-multibyte-characters) + (erase-buffer) + ,@body)) (put 'elmo-set-work-buf 'lisp-indent-function 0) (def-edebug-spec elmo-set-work-buf t) (defmacro elmo-bind-directory (dir &rest body) "Set current directory DIR and execute BODY." - (` (let ((default-directory (file-name-as-directory (, dir)))) - (,@ body)))) + `(let ((default-directory (file-name-as-directory ,dir))) + ,@body)) (put 'elmo-bind-directory 'lisp-indent-function 1) (def-edebug-spec elmo-bind-directory @@ -96,6 +98,14 @@ (put 'elmo-with-enable-multibyte 'lisp-indent-function 0) (def-edebug-spec elmo-with-enable-multibyte t) +(static-if (condition-case nil + (plist-get '(one) 'other) + (error t)) + (defmacro elmo-safe-plist-get (plist prop) + `(ignore-errors + (plist-get ,plist ,prop))) + (defalias 'elmo-safe-plist-get 'plist-get)) + (eval-when-compile (unless (fboundp 'coding-system-base) (defalias 'coding-system-base 'ignore)) @@ -160,7 +170,7 @@ with FILENAME which defaults to `buffer-file-name'." (goto-char (point-min)) (setq case-fold-search nil) (re-search-forward "^;;;coding system: " - ;;(+ (point-min) 3000) t)) +;;; (+ (point-min) 3000) t)) nil t)) (looking-at "[^\t\n\r ]+") (find-coding-system @@ -407,14 +417,14 @@ Return value is a cons cell of (STRUCTURE . REST)" (defsubst elmo-delete-char (char string &optional unibyte) (save-match-data (elmo-set-work-buf - (let ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) - (if unibyte (set-buffer-multibyte nil)) - (insert string) - (goto-char (point-min)) - (while (search-forward (char-to-string char) nil t) - (replace-match "")) - (buffer-string))))) + (let ((coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion)) + (if unibyte (set-buffer-multibyte nil)) + (insert string) + (goto-char (point-min)) + (while (search-forward (char-to-string char) nil t) + (replace-match "")) + (buffer-string))))) (defsubst elmo-delete-cr-buffer () "Delete CR from buffer." @@ -435,11 +445,11 @@ Return value is a cons cell of (STRUCTURE . REST)" (defun elmo-delete-cr (string) (save-match-data (elmo-set-work-buf - (insert string) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - (buffer-string)))) + (insert string) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + (buffer-string)))) (defun elmo-last (list) (and list (nth (1- (length list)) list))) @@ -474,6 +484,10 @@ Return value is a cons cell of (STRUCTURE . REST)" (setq list (cdr list)))) list) +(defun elmo-union (l1 l2) + "Make a union of two lists" + (elmo-uniq-sorted-list (sort (append l1 l2) #'<))) + (defun elmo-list-insert (list element after) (let* ((match (memq after list)) (rest (and match (cdr (memq after list))))) @@ -485,26 +499,26 @@ Return value is a cons cell of (STRUCTURE . REST)" (defun elmo-get-file-string (filename &optional remove-final-newline) (elmo-set-work-buf - (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas... - insert-file-contents-post-hook) - (when (file-exists-p filename) - (if filename - (as-binary-input-file (insert-file-contents filename))) - (when (and remove-final-newline - (> (buffer-size) 0) - (= (char-after (1- (point-max))) ?\n)) - (goto-char (point-max)) - (delete-backward-char 1)) - (buffer-string))))) + (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas... + insert-file-contents-post-hook) + (when (file-exists-p filename) + (if filename + (as-binary-input-file (insert-file-contents filename))) + (when (and remove-final-newline + (> (buffer-size) 0) + (= (char-after (1- (point-max))) ?\n)) + (goto-char (point-max)) + (delete-char -1)) + (buffer-string))))) (defun elmo-save-string (string filename) (if string (elmo-set-work-buf - (as-binary-output-file - (insert string) - (write-region (point-min) (point-max) - filename nil 'no-msg)) - ))) + (as-binary-output-file + (insert string) + (write-region (point-min) (point-max) + filename nil 'no-msg)) + ))) (defun elmo-max-of-list (nlist) (let ((l nlist) @@ -557,7 +571,7 @@ Return value is a cons cell of (STRUCTURE . REST)" print-length print-level) (prin1 elmo-passwd-alist (current-buffer)) (princ "\n" (current-buffer)) -;;; (if (and (file-exists-p filename) +;;; (if (and (file-exists-p filename) ;;; (not (equal 384 (file-modes filename)))) ;;; (error "%s is not safe.chmod 600 %s!" filename filename)) (if (file-writable-p filename) @@ -583,7 +597,7 @@ Return value is a cons cell of (STRUCTURE . REST)" (elmo-base64-encode-string pass))))) (if elmo-passwd-life-time (run-with-timer elmo-passwd-life-time nil - (` (lambda () (elmo-remove-passwd (, key)))))) + `(lambda () (elmo-remove-passwd ,key)))) pass))) (defun elmo-remove-passwd (key) @@ -650,13 +664,13 @@ Return value is a cons cell of (STRUCTURE . REST)" (defun elmo-string-to-list (string) (elmo-set-work-buf - (insert string) - (goto-char (point-min)) - (insert "(") - (goto-char (point-max)) - (insert ")") - (goto-char (point-min)) - (read (current-buffer)))) + (insert string) + (goto-char (point-min)) + (insert "(") + (goto-char (point-max)) + (insert ")") + (goto-char (point-min)) + (read (current-buffer)))) (defun elmo-list-to-string (list) (let ((tlist list) @@ -811,7 +825,7 @@ Return value is a cons cell of (STRUCTURE . REST)" (directory-files path t "^[^\\.]") (error nil))) (result 0.0)) - ;; (result (nth 7 file-attr))) ... directory size +;;; (result (nth 7 file-attr))) ; ... directory size (while files (setq result (+ result (or (elmo-disk-usage (car files)) 0))) (setq files (cdr files))) @@ -1221,14 +1235,14 @@ If optional DELETE-FUNCTION is speficied, it is used as delete procedure." (if (or (elmo-progress-counter-total counter) (and (elmo-progress-counter-set-total counter - (plist-get params :total)) + (elmo-safe-plist-get params :total)) (elmo-progress-call-callback counter 'query))) (progn (elmo-progress-counter-set-value counter - (or (plist-get params :set) + (or (elmo-safe-plist-get params :set) (+ (elmo-progress-counter-value counter) - (or (plist-get params :inc) + (or (elmo-safe-plist-get params :inc) (car params) 1)))) (elmo-progress-call-callback counter)) @@ -1268,9 +1282,10 @@ MESSAGE is a doing part of progress message." (and (eq (car diff) 0) (< diff-time (nth 1 diff))))) -(if (fboundp 'std11-fetch-field) - (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region - (defalias 'elmo-field-body 'std11-field-body)) +(eval-and-compile + (if (fboundp 'std11-fetch-field) + (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region + (defalias 'elmo-field-body 'std11-field-body))) (defun elmo-unfold-field-body (name) (let ((value (elmo-field-body name))) @@ -1295,9 +1310,9 @@ MESSAGE is a doing part of progress message." (defmacro elmo-string (string) "STRING without text property." - (` (let ((obj (copy-sequence (, string)))) - (and obj (set-text-properties 0 (length obj) nil obj)) - obj))) + `(let ((obj (copy-sequence ,string))) + (and obj (set-text-properties 0 (length obj) nil obj)) + obj)) (defun elmo-flatten (list-of-list) "Flatten LIST-OF-LIST." @@ -1698,12 +1713,12 @@ NUMBER-SET is altered." prev (nconc (list - ;; (beg . (1- number)) +;;; (beg . (1- number)) (let ((new (cons (car elem) (1- number)))) (if (eq (car new) (cdr new)) (car new) new)) - ;; ((1+ number) . end) +;;; ((1+ number) . end) (let ((new (cons (1+ number) (cdr elem)))) (if (eq (car new) (cdr new)) (car new) @@ -1851,15 +1866,15 @@ STATUS is one of 'section, 'entire or nil. 'section means partial section cache exists. 'entire means entire cache exists. If the cache is partial file-cache, TYPE is 'partial." - (` (cons (, path) (, status)))) + `(cons ,path ,status)) (defmacro elmo-file-cache-path (file-cache) "Returns the file path of the FILE-CACHE." - (` (car (, file-cache)))) + `(car ,file-cache)) (defmacro elmo-file-cache-status (file-cache) "Returns the status of the FILE-CACHE." - (` (cdr (, file-cache)))) + `(cdr ,file-cache)) (defsubst elmo-cache-to-msgid (filename) (concat "<" (elmo-recover-string-from-filename filename) ">")) @@ -1896,7 +1911,7 @@ If optional argument SECTION is specified, partial cache path is returned." "Return file name for the file-cache corresponds to the section. PATH is the file-cache path. SECTION is the section string." - (` (expand-file-name (or (, section) "") (, path)))) + `(expand-file-name (or ,section "") ,path)) (defun elmo-file-cache-delete (path) "Delete a cache on PATH." @@ -2058,7 +2073,7 @@ If KBYTES is kilo bytes (This value must be float)." (cons (car (car cfl)) (car flist))))) (setq cfl (cdr cfl))) -;;; (prin1 firsts) +;;; (prin1 firsts) (while firsts (if (and (not oldest-entity) (cdr (cdr (car firsts)))) @@ -2096,12 +2111,12 @@ If KBYTES is kilo bytes (This value must be float)." "Expire cache file by age. Optional argument DAYS specifies the days to expire caches." (interactive) - (let ((age (or (and days (int-to-string days)) + (let ((age (or (and days (number-to-string days)) (and (interactive-p) (read-from-minibuffer (format "Enter days (%s): " elmo-cache-expire-default-age))) - (int-to-string elmo-cache-expire-default-age))) + (number-to-string elmo-cache-expire-default-age))) (dirs (directory-files elmo-cache-directory t "^[^\\.]")) @@ -2109,7 +2124,7 @@ Optional argument DAYS specifies the days to expire caches." curtime) (if (string= age "") (setq age elmo-cache-expire-default-age) - (setq age (string-to-int age))) + (setq age (string-to-number age))) (setq curtime (current-time)) (setq curtime (+ (* (nth 0 curtime) (float 65536)) (nth 1 curtime))) @@ -2211,13 +2226,13 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." (save-match-data (let (beg) (elmo-set-work-buf - (insert string) - (goto-char (point-max)) - (when (search-backward "<" nil t) - (setq beg (point)) - (if (search-forward ">" nil t) - (elmo-replace-in-string - (buffer-substring beg (point)) "\n[ \t]*" "")))))))) + (insert string) + (goto-char (point-max)) + (when (search-backward "<" nil t) + (setq beg (point)) + (if (search-forward ">" nil t) + (elmo-replace-in-string + (buffer-substring beg (point)) "\n[ \t]*" "")))))))) (defun elmo-msgdb-get-message-id-from-buffer () (let ((msgid (elmo-field-body "message-id"))) @@ -2254,7 +2269,8 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." file nil beg (incf beg elmo-msgdb-file-header-chop-length)))) (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max)))))))) + (goto-char (point-max))))) + (elmo-delete-cr-buffer)))) ;; ;; overview handling