(cmd (if (featurep 'xemacs)
(event-to-character last-command-event)
(string-to-char (format "%s" (this-command-keys))))))
- (message mes-string)
+ (message "%s" mes-string)
(setq key (car (setq keve (wl-read-event-char))))
(if (or (equal key ?\ )
(and cmd
(funcall func))
(wl-push (cdr keve) unread-command-events))))
+(defun wl-require-update-all-folder-p (name)
+ "Return non-nil if NAME is draft or queue folder."
+ (or (string= name wl-draft-folder)
+ (string= name wl-queue-folder)))
+
;(defalias 'wl-make-hash 'elmo-make-hash)
;;(make-obsolete 'wl-make-hash 'elmo-make-hash)
;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
-(defsubst wl-set-string-width (width string &optional padding)
+(defsubst wl-set-string-width (width string &optional padding ignore-invalid)
"Make a new string which have specified WIDTH and content of STRING.
+`wl-invalid-character-message' is used when invalid character is contained.
If WIDTH is negative number, padding chars are added to the head and
otherwise, padding chars are added to the tail of the string.
The optional 3rd arg PADDING, if non-nil, specifies a padding character
-to add the result instead of white space."
+to add the result instead of white space.
+If optional 4th argument is non-nil, don't use `wl-invalid-character-message'
+even when invalid character is contained."
(static-cond
((and (fboundp 'string-width) (fboundp 'truncate-string-to-width)
(not (featurep 'xemacs)))
(setq string (truncate-string-to-width string (abs width))))
(if (= (string-width string) (abs width))
string
- (if (< (abs width) (string-width string))
- (wl-set-string-width width
- wl-invalid-character-message
- padding)
- (let ((paddings (make-string
- (max 0 (- (abs width) (string-width string)))
- (or padding ?\ ))))
- (if (< width 0)
- (concat paddings string)
- (concat string paddings))))))
+ (when (and (not ignore-invalid)
+ (< (abs width) (string-width string)))
+ (setq string
+ (truncate-string-to-width wl-invalid-character-message
+ (abs width))))
+ (let ((paddings (make-string
+ (max 0 (- (abs width) (string-width string)))
+ (or padding ?\ ))))
+ (if (< width 0)
+ (concat paddings string)
+ (concat string paddings)))))
(t
(elmo-set-work-buf
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
value pair)
(while alist
(setq pair (car alist))
- (if (string-match (car pair) folder)
- (cond ((eq match 'all)
- (setq value (append value (list (cdr pair)))))
- ((eq match 'all-list)
- (setq value (append value (cdr pair))))
- ((not match)
- (throw 'found (cdr pair)))))
+ (if (and (eq match 'function)
+ (functionp (car pair)))
+ (when (funcall (car pair) folder)
+ (throw 'found (cdr pair)))
+ (if (string-match (car pair) folder)
+ (cond ((eq match 'all)
+ (setq value (append value (list (cdr pair)))))
+ ((eq match 'all-list)
+ (setq value (append value (cdr pair))))
+ ((or (not match) (eq match 'function))
+ (throw 'found (cdr pair))))))
(setq alist (cdr alist)))
value)))
(put 'wl-as-mime-charset 'lisp-indent-function 1)
(eval-and-compile
- (if 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))))
- (if 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)))))))
+ (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)))))
+ (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)))))
+ (t
+ (defmacro wl-as-coding-system (coding-system &rest body)
+ (` (progn (,@ body)))))))
(defmacro wl-as-mime-charset (mime-charset &rest body)
(` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset))
(defalias 'wl-string 'elmo-string)
(make-obsolete 'wl-string 'elmo-string)
-;; Check if active region exists or not.
-(if (boundp 'mark-active)
- (defmacro wl-region-exists-p ()
- 'mark-active)
- (if (fboundp 'region-exists-p)
- (defmacro wl-region-exists-p ()
- (list 'region-exists-p))))
-
(if (not (fboundp 'overlays-in))
(defun overlays-in (beg end)
"Return a list of the overlays that overlap the region BEG ... END.
folder nil nil nil t)
(wl-summary-goto-folder-subr
folder 'update nil nil t)
- (goto-char (point-min))
- (re-search-forward (concat "^ *" msg) nil t)
+ (wl-summary-jump-to-msg (string-to-number msg))
(wl-summary-redisplay)))
(message "Not a nntp: url."))))
(defmacro wl-concat-list (list separator)
(` (mapconcat 'identity (delete "" (delq nil (, list))) (, separator))))
-(defmacro wl-current-message-buffer ()
- (` (save-excursion
- (if (buffer-live-p wl-current-summary-buffer)
- (set-buffer wl-current-summary-buffer))
- wl-message-buffer)))
+(defun wl-current-message-buffer ()
+ (when (buffer-live-p wl-current-summary-buffer)
+ (with-current-buffer wl-current-summary-buffer
+ (or wl-message-buffer
+ (and (wl-summary-message-number)
+ (car (wl-message-buffer-display wl-summary-buffer-elmo-folder
+ (wl-summary-message-number)
+ 'mime)))))))
(defmacro wl-kill-buffers (regexp)
(` (mapcar (function
(defun wl-collect-draft ()
(let ((draft-regexp (concat
- "^" (regexp-quote
- (elmo-localdir-folder-directory-internal
- (wl-folder-get-elmo-folder wl-draft-folder)))))
+ "^" (regexp-quote wl-draft-folder)))
result buf)
(mapcar
(function (lambda (x)
- (if (and
- (setq buf (with-current-buffer x
- wl-draft-buffer-file-name))
- (string-match draft-regexp buf))
+ (if (with-current-buffer x
+ (and (eq major-mode 'wl-draft-mode)
+ (buffer-name)
+ (string-match draft-regexp (buffer-name))))
(setq result (nconc result (list x))))))
(buffer-list))
result))
(static-if (fboundp 'read-directory-name)
- (defalias 'wl-read-directory-name 'read-directory-name)
+ (defun wl-read-directory-name (prompt dir)
+ (read-directory-name prompt dir dir))
(defun wl-read-directory-name (prompt dir)
(let ((dir (read-file-name prompt dir)))
(unless (file-directory-p dir)
(defvar wl-load-profile-function 'wl-local-load-profile)
(defun wl-local-load-profile ()
"Load `wl-init-file'."
- (message "Initializing ...")
+ (message "Initializing...")
(load wl-init-file 'noerror 'nomessage))
(defun wl-load-profile ()
(defun wl-biff-check-folder (folder)
(if (eq (elmo-folder-type-internal folder) 'pop3)
- (unless (elmo-pop3-get-session folder 'if-exists)
+ (unless (elmo-pop3-get-session folder 'any-exists)
(wl-folder-check-one-entity (elmo-folder-name-internal folder)
'biff))
(wl-folder-check-one-entity (elmo-folder-name-internal folder)
(concat open-paren (mapconcat 'regexp-quote strings "\\|")
close-paren))))
-(defun wl-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)))
+(defalias 'wl-expand-newtext 'elmo-expand-newtext)
+(defalias 'wl-regexp-opt 'elmo-regexp-opt)
+
+(defun wl-region-exists-p ()
+ "Return non-nil if a region exists on current buffer."
+ (static-if (featurep 'xemacs)
+ (region-active-p)
+ (and transient-mark-mode mark-active)))
+
+(defun wl-deactivate-region ()
+ "Deactivate region on current buffer"
+ (static-if (not (featurep 'xemacs))
+ (setq mark-active nil)))
(defvar wl-line-string)
(defun wl-line-parse-format (format spec-alist)
(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."
+ (with-current-buffer dst
+ (dolist (variable local-variables)
+ (set (make-local-variable variable)
+ (with-current-buffer src
+ (symbol-value variable))))))
+
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff