X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-util.el;h=30f0740521033d0e8cb4e2652db43ba72160242c;hb=000345eadd81debeb1527fb65e46109c96fc35e0;hp=db27706bcacfe80daee2e52792f0228f2205ef18;hpb=527a3bfc7a6e9f06009e56546b5972d042bcd8f2;p=elisp%2Fwanderlust.git diff --git a/wl/wl-util.el b/wl/wl-util.el index db27706..30f0740 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -173,10 +173,15 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, ;;(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))) @@ -184,40 +189,34 @@ otherwise, padding spaces are added to the tail of the string." (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))) @@ -581,7 +580,8 @@ that `read' can handle, whenever this is possible." 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) @@ -667,7 +667,7 @@ that `read' can handle, whenever this is possible." (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 () @@ -846,7 +846,7 @@ This function is imported from Emacs 20.7." (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) @@ -897,42 +897,17 @@ is enclosed by at least one regexp grouping construct." (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) +(defun wl-region-exists-p () + "Return non-nil if a region exists on current buffer." + (static-if (featurep 'xemacs) + (and zmacs-regions zmacs-region-active-p) + (and transient-mark-mode mark-active))) + +(defvar wl-line-string) (defun wl-line-parse-format (format spec-alist) - "Make a formatter from FORMAT and SPEC-ALIST. -WIDTH is the width of the result string." + "Make a formatter from FORMAT and SPEC-ALIST." (let (f spec specs stack) (setq f (with-temp-buffer @@ -942,12 +917,12 @@ WIDTH is the width of the result string." (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 + (error "No number specification for %%( line format")) + (push (list (match-beginning 0) ; start (match-end 0) ; start-content (string-to-number @@ -955,12 +930,12 @@ WIDTH is the width of the result string." specs) ; specs stack) (setq specs nil)) - ((string= (match-string 2) ")") + ((string= (match-string 3) ")") (let ((entry (pop stack)) form) (unless entry (error - "No matching %( parenthesis in summary line format")) + "No matching %%( parenthesis in summary line format")) (goto-char (car entry)) ; start (setq form (buffer-substring (nth 1 entry) ; start-content (- (match-beginning 0) 1))) @@ -975,16 +950,22 @@ WIDTH is the width of the result string." 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)))