(defmacro wl-match-string (pos string)
"Substring POSth matched STRING."
- (` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
+ `(substring ,string (match-beginning ,pos) (match-end ,pos)))
(defmacro wl-match-buffer (pos)
"Substring POSth matched from the current buffer."
- (` (buffer-substring-no-properties
- (match-beginning (, pos)) (match-end (, pos)))))
+ `(buffer-substring-no-properties
+ (match-beginning ,pos) (match-end ,pos)))
(put 'wl-as-coding-system 'lisp-indent-function 1)
(put 'wl-as-mime-charset 'lisp-indent-function 1)
(cond
(wl-on-mule3
(defmacro wl-as-coding-system (coding-system &rest body)
- (` (let ((coding-system-for-read (, coding-system))
- (coding-system-for-write (, coding-system)))
- (,@ body)))))
+ `(let ((coding-system-for-read ,coding-system)
+ (coding-system-for-write ,coding-system))
+ ,@body)))
(wl-on-mule
(defmacro wl-as-coding-system (coding-system &rest body)
- (` (let ((file-coding-system-for-read (, coding-system))
- (file-coding-system (, coding-system)))
- (,@ body)))))
+ `(let ((file-coding-system-for-read ,coding-system)
+ (file-coding-system ,coding-system))
+ ,@body)))
(t
(defmacro wl-as-coding-system (coding-system &rest body)
- (` (progn (,@ body)))))))
+ `(progn ,@body)))))
(defmacro wl-as-mime-charset (mime-charset &rest body)
- (` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset))
- (,@ body))))
+ `(wl-as-coding-system (mime-charset-to-coding-system ,mime-charset)
+ ,@body))
(defalias 'wl-string 'elmo-string)
(make-obsolete 'wl-string 'elmo-string)
(message "Not a nntp: url."))))
(defmacro wl-concat-list (list separator)
- (` (mapconcat 'identity (delete "" (delq nil (, list))) (, separator))))
+ `(mapconcat 'identity (delete "" (delq nil ,list)) ,separator))
(defun wl-current-message-buffer ()
(when (buffer-live-p wl-current-summary-buffer)
nil nil))))))
(defmacro wl-kill-buffers (regexp)
- (` (mapcar (function
- (lambda (x)
- (if (and (buffer-name x)
- (string-match (, regexp) (buffer-name x)))
- (and (get-buffer x)
- (kill-buffer x)))))
- (buffer-list))))
+ `(mapcar (function
+ (lambda (x)
+ (if (and (buffer-name x)
+ (string-match ,regexp (buffer-name x)))
+ (and (get-buffer x)
+ (kill-buffer x)))))
+ (buffer-list)))
(defun wl-collect-summary ()
(let (result)
(static-if (fboundp 'local-variable-p)
(defalias 'wl-local-variable-p 'local-variable-p)
(defmacro wl-local-variable-p (symbol &optional buffer)
- (` (if (assq (, symbol) (buffer-local-variables (, buffer)))
- t))))
+ `(if (assq ,symbol (buffer-local-variables ,buffer))
+ t)))
(defun wl-number-base36 (num len)
(if (if (< len 0)
;;;
(defmacro wl-count-lines ()
- (` (save-excursion
- (beginning-of-line)
- (count-lines 1 (point)))))
+ '(save-excursion
+ (beginning-of-line)
+ (count-lines 1 (point))))
(defun wl-horizontal-recenter ()
"Recenter the current buffer horizontally."
(while flist
(setq folder (wl-folder-get-elmo-folder (car flist))
flist (cdr flist))
+ (elmo-folder-set-biff-internal folder t)
(when (and (elmo-folder-plugged-p folder)
(elmo-folder-exists-p folder))
(setq new-mails
(append (list 'format f) specs)))
(defmacro wl-line-formatter-setup (formatter format alist)
- (` (let (byte-compile-warnings)
- (setq (, formatter)
- (byte-compile
- (list 'lambda ()
- (wl-line-parse-format (, format) (, alist)))))
- (when (get-buffer "*Compile-Log*")
- (bury-buffer "*Compile-Log*"))
- (when (get-buffer "*Compile-Log-Show*")
- (bury-buffer "*Compile-Log-Show*")))))
+ `(let (byte-compile-warnings)
+ (setq ,formatter
+ (byte-compile
+ (list 'lambda ()
+ (wl-line-parse-format ,format ,alist))))
+ (when (get-buffer "*Compile-Log*")
+ (bury-buffer "*Compile-Log*"))
+ (when (get-buffer "*Compile-Log-Show*")
+ (bury-buffer "*Compile-Log-Show*"))))
(defsubst wl-copy-local-variables (src dst local-variables)
"Copy value of LOCAL-VARIABLES from SRC buffer to DST buffer."
(symbol-value variable))))))
;;; Search Condition
+(defun wl-search-condition-fields ()
+ (let ((denial-fields
+ (nconc (mapcar 'capitalize elmo-msgdb-extra-fields)
+ (mapcar 'capitalize wl-additional-search-condition-fields)
+ '("Flag" "Since" "Before"
+ "From" "Subject" "To" "Cc" "Body" "ToCc"
+ "Larger" "Smaller"))))
+ (append '("Last" "First")
+ denial-fields
+ (mapcar (lambda (f) (concat "!" f))
+ denial-fields))))
+
(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"
- "Larger" "Smaller")))
(field (completing-read
(format "%s (%s): " prompt default)
- (mapcar 'list
- (append '("AND" "OR" "Last" "First")
- denial-fields
- (mapcar (lambda (f) (concat "!" f))
- denial-fields)))))
+ (mapcar #'list
+ (append '("AND" "OR") (wl-search-condition-fields)))))
value)
(setq field (if (string= field "")
(setq field default)
(if beg
(cons beg end)))))
+(defun wl-simple-display-progress (label action current total)
+ (message "%s... %d%%"
+ action
+ (if (> total 0) (floor (* (/ current (float total)) 100)) 0)))
+
+(when (fboundp 'progress-feedback-with-label)
+ (defun wl-display-progress-with-gauge (label action current total)
+ (progress-feedback-with-label
+ label
+ "%s..."
+ (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
+ action)))
+
+(defun wl-progress-callback-function (label action current total)
+ (case current
+ (query
+ (let ((threshold (if (consp wl-display-progress-threshold)
+ (cdr (or (assq label wl-display-progress-threshold)
+ (assq t wl-display-progress-threshold)))
+ wl-display-progress-threshold)))
+ (and threshold
+ (>= total threshold))))
+ (start
+ (message "%s..." action))
+ (done
+ (message "%s...done" action))
+ (t
+ (when wl-display-progress-function
+ (funcall wl-display-progress-function label action current total)))))
+
;; read multiple strings with completion
(defun wl-completing-read-multiple-1 (prompt
table
nil initial-input
hist def inherit-input-method))))
(t
- (defalias 'wl-completing-read-multiple 'wl-completing-read-multiple-2)))
+ (defalias 'wl-completing-read-multiple 'completing-read-multiple)))
+(cond
+ ((fboundp 'shell-command-read-minibuffer)
+ (defun wl-read-shell-command (prompt &optional
+ initial-contents keymap read hist)
+ (shell-command-read-minibuffer prompt default-directory
+ initial-contents keymap read hist)))
+ (t
+ (defalias 'wl-read-shell-command 'read-from-minibuffer)))
+
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff