(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)
+(defsubst wl-set-string-width (width string &optional padding ignore-invalid)
"Make a new string which have specified WIDTH and content of STRING.
-If WIDTH is negative number, padding spaces are added to the head and
-otherwise, padding spaces are added to the tail of the 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.
+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 (< width 0)
- (concat (format (format "%%%ds"
- (- (abs width) (string-width string)))
- " ")
- string)
- (concat string
- (format (format "%%%ds"
- (- (abs width) (string-width string)))
- " ")))))
+ (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)
(insert string)
- (if (> (current-column) (abs width))
- (if (> (move-to-column (abs width)) (abs width))
- (progn
- (condition-case nil ; ignore error
- (backward-char 1)
- (error))
- (if (< width 0)
- (concat " " (buffer-substring (point-min) (point)))
- (concat (buffer-substring (point-min) (point)) " ")))
- (buffer-substring (point-min) (point)))
- (if (= (current-column) (abs width))
- string
+ (when (> (current-column) (abs width))
+ (when (> (move-to-column (abs width)) (abs width))
+ (condition-case nil ; ignore error
+ (backward-char 1)
+ (error)))
+ (setq string (buffer-substring (point-min) (point))))
+ (if (= (current-column) (abs width))
+ string
+ (let ((paddings (make-string (- (abs width) (current-column))
+ (or padding ?\ ))))
(if (< width 0)
- (concat (format (format "%%%ds"
- (- (abs width) (current-column)))
- " ")
- string)
- (concat string
- (format (format "%%%ds"
- (- (abs width) (current-column)))
- " ")))))))))
+ (concat paddings string)
+ (concat string paddings))))))))
(defun wl-mode-line-buffer-identification (&optional id)
(let ((priorities '(biff plug title)))
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)
"Make a formatter from FORMAT and SPEC-ALIST."
(let (f spec specs stack)
(cond
((looking-at "%")
(goto-char (match-end 0)))
- ((looking-at "\\(-?[0-9]*\\)\\([^0-9]\\)")
+ ((looking-at "\\(-?\\(0?\\)[0-9]*\\)\\([^0-9]\\)")
(cond
- ((string= (match-string 2) "(")
+ ((string= (match-string 3) "(")
(if (zerop (length (match-string 1)))
(error "No number specification for %%( line format"))
- (push (list
+ (push (list
(match-beginning 0) ; start
(match-end 0) ; start-content
(string-to-number
specs) ; specs
stack)
(setq specs nil))
- ((string= (match-string 2) ")")
+ ((string= (match-string 3) ")")
(let ((entry (pop stack))
form)
(unless entry
specs)))))))
(t
(setq spec
- (if (setq spec (assq (string-to-char (match-string 2))
+ (if (setq spec (assq (string-to-char (match-string 3))
spec-alist))
(nth 1 spec)
- (match-string 2)))
+ (match-string 3)))
(unless (string= "" (match-string 1))
(setq spec (list 'wl-set-string-width
(string-to-number (match-string 1))
- spec)))
+ spec
+ (unless (string= "" (match-string 2))
+ (string-to-char (match-string 2))))))
(replace-match "s" 'fixed)
- (setq specs (append specs (list spec))))))))
+ (setq specs (append specs
+ (list
+ (list
+ 'setq 'wl-line-string
+ spec)))))))))
(buffer-string)))
(append (list 'format f) specs)))
(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